Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Mehrere Tabellenblätter zusammenfassen und per Mail schicken
#1
Hey Leute,

ich fasse mich in 2 Posts.

Ich habe eine Datei, in der ich eine Userform eingefügt habe. Mit dieser Userform werden Daten gefiltert, anschließend werden die gefilterten Daten auf ein neues Tabellenblatt kopiert, dieses wird benannt, dann wird der Name der Datei eingegeben und das aktuelle Tabellenblatt wird als gesonderte Datei per mail verschickt.

Mein Problem ist, das ist immer nur das aktuelle Tabellenblatt geschickt wird. Mein Traum wäre eine Auswahlliste aller Tabellenblätter in der Userform, wo ich dann aussuchen kann, welches ich, in einer gesonderten Datei, verschicken möchte

Der Code dafür ist unten beigefügt. Falls ihr es lieber sehen wollt, ist auch eine Datei dabei. Ich hoffe es geht alles, musste sehr viel aus der Tabelle löschen. 


Code:
Private Sub CommandButton2_Click()

   Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim Sourcewb As Workbook
   Dim Destwb As Workbook
   Dim TempFilePath As String
   Dim TempFileName As String
   Dim OutApp As Object
   Dim OutMail As Object

   With Application
       .ScreenUpdating = False
       .EnableEvents = False
   End With

   Set Sourcewb = ActiveWorkbook

   'Copy the ActiveSheet to a new workbook
   ActiveSheet.Copy
   Set Destwb = ActiveWorkbook
   
   'ThisWorkbook.Worksheets(Array("Tabelle14", "Diagramm2")).Copy

   'Determine the Excel version and file extension/format
   With Destwb
       If Val(Application.Version) < 12 Then
           'You use Excel 97-2003
           FileExtStr = ".xls": FileFormatNum = -4143
       Else
           'You use Excel 2007-2016
           Select Case Sourcewb.FileFormat
           Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
           Case 52:
               If .HasVBProject Then
                   FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                   FileExtStr = ".xlsx": FileFormatNum = 51
               End If
           Case 56: FileExtStr = ".xls": FileFormatNum = 56
           Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
           End Select
       End If
   End With

   '    'Change all cells in the worksheet to values if you want
   '    With Destwb.Sheets(1).UsedRange
   '        .Cells.Copy
   '        .Cells.PasteSpecial xlPasteValues
   '        .Cells(1).Select
   '    End With
   '    Application.CutCopyMode = False

   'Save the new workbook/Mail it/Delete it
   TempFilePath = Environ$("temp") & "\"
   TempFileName = TextBoxDatei.Text

   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)

   With Destwb
       .SaveAs "U:\TestTabellen\" & TempFileName & FileExtStr, FileFormat:=FileFormatNum
       On Error Resume Next
       With OutMail
           .to = ""
           .CC = ""
           .BCC = ""
           .Subject = "Test"
           .Body = "Hallo anbei die Tabelle"
           .Attachments.Add Destwb.FullName
           
           'Anhang hinzufügen
           '.Attachments.Add ("U:\Test für Senden.xlsx")
           '.Send or use
           .Display
       End With
       On Error GoTo 0
       .Close savechanges:=False
   End With

   'Delete the file you have send
   
   'Kill TempFilePath & TempFileName & FileExtStr

   'Set OutMail = Nothing
 '  Set OutApp = Nothing

  ' With Application
  '     .ScreenUpdating = True
  '     .EnableEvents = True
 '  End With
End Sub


danke schon mal für die Mühe   19


Angehängte Dateien
.xlsm   Forum.xlsm (Größe: 70,03 KB / Downloads: 2)
Antwortento top
#2
Hallo, 19

probiere es mal so der Spur nach: 21

.xlsm   UF_Tabellenblaeter_speichern.xlsm (Größe: 74,93 KB / Downloads: 3)

Jedesmal wenn Du die UserForm startest oder in der Form auf "Kopieren" klickst wird das neue Tabellenblatt in der ListBox angezeigt. Dort kannst Du mehrere auswählen und dann versenden. Im Moment wird die Datei unter "C:\Temp\" gespeichert - also anpassen.
________
Servus
Case
[-] Folgende(r) 1 Benutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antwortento top
#3
Hey, wenn ich deine Code also: 
Code:
Private Sub UserForm_Activate()
   Dim lngTMP As Long
   Dim strSheets() As String
   ReDim strSheets(1 To Worksheets.Count)
   For lngTMP = 1 To Sheets.Count
       strSheets(lngTMP) = Worksheets(lngTMP).Name
   Next
   ListBox1.List = strSheets
End Sub

in meine "richtige" Tabelle überführe, dann kann ich immer nur eine Tabelle in der Liste anklicken. :( ansonsten klappt das schon super!

Edit: 
Code:
ListBox1.MultiSelect = fmMultiSelectMulti

einfügen dann klappt es !
Antwortento top
#4
Hallo, 19

nimm noch folgende Codezeile mit auf: 21

Code:
ListBox1.MultiSelect = 1

Oder stelle es in den Eigenschaften der ListBox ein.
________
Servus
Case
[-] Folgende(r) 1 Benutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antwortento top
#5
klappt alles perfekt danke dir! Du hast echt genau das geschafft was ich brauchteSmile

Kleine Zusatzaufgabe?  Sleepy 
Wie aktualisiere ich die ListBox? Entweder per Knopf druck auf eine neue Schaltfläche oder in die Schaltfläche "übernehmen" implementieren?


LG
Antwortento top
#6
Hallo, 19

genauso wie im Button "Kopieren". 21
________
Servus
Case
Antwortento top
#7
Das verstehe ich jetzt nicht :D
Wenn ich jetzt die Tabellen umbennen muss ich erst die Userform schließen und dann wieder öffnen. Gibt es keine anderen Möglichkeit? Ich habe etwas gelesen darüber das man es über die Zeit regeln kann oder über die Bewegung der Maus, allerdings habe ich nichts passenden gefunden. 
Ansonsten mache ich ein neues Thema auf  Idea
Antwortento top
#8
Hallo, 19

im Code vom CommandButton "Kopieren" habe ich am Ende zwei Codezeilen hinzugefügt - die sehe ich ohne Brille (sonst brauche ich eine). Die Zeile mit Call... kopierst Du einfach ans Ende des CommandButton "Übernehmen" - dazu braucht es keine neues Thema. 17
________
Servus
Case
[-] Folgende(r) 1 Benutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antwortento top
#9
Wald vor läuter Bäumen....


danke! klappt!

ALLES KLAPPT!
Antwortento top
#10
Hallo, 19

dafür ist die Codezeile...

Code:
Application.Goto Tabelle1.Range("A1"), True

... verantwortlich. 21

Die einfach auskommentieren bzw. rausnehmen.
________
Servus
Case
[-] Folgende(r) 1 Benutzer sagt Danke an Case für diesen Beitrag:
  • elamigo
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste