Gruppieren wenn bestimmtes Sheet aktiv
10.02.2021 08:47:10
Stefan
Ich erzeuge aktuell über die Array Funktion (Gruppieren) von 2 Tabellenblättern eine PDF.
Aus den 2 Sheets (Packaging Instruction und History) muss IMMER eine PDF erzeugt werden. In manchen Fällen kann es jedoch sein, dass ein 3. Sheet ("Verteiler") eingeblendet wird und dieses ebenfalls in der PDF Erstellung beinhaltet sein soll (PDF = 3 Seiten) .
Die Arbeitsmappe selbst kann mehrere eingeblendete Sheets enthalten, PDF soll aber immer nur von "Packaging Instruction" und "History" erstellt werden und - wenn eben von User eingeblendet wurde - auch vom "Verteiler".
Kann mir jemand helfen?
Anbei mal der bisherige Code (für 2 Seiten):
Private Sub CommandButton2_Click()
'PDF + E-Mail
'by Xpert on www.pctipp.ch/forum (04.12.2012) modified by F. Sielck 2021-01-05
Dim strDateiname As String
Dim strPfad As String
Dim strPDF As String
Dim strTo As String
Dim iItem As Integer
Dim objOutlook As Object
Dim objMail As Object
'Empfänger der E-mail zusammenstellen
With Me.ListBox2
For iItem = 0 To .ListCount - 1
If .Selected(iItem) = True Then
If strTo = "" Then
strTo = .List(iItem, 2)
Else
strTo = strTo & ";" & .List(iItem, 2)
End If
End If
Next
End With
If Me.TextBox1 "" Then
If strTo = "" Then
strTo = Me.TextBox1
Else
strTo = strTo & ";" & Me.TextBox1
End If
End If
If strTo = "" Then
If MsgBox("No Receiver selected !", _
vbOKCancel + vbDefaultButton2, "Create PDF and Open Email ") = vbCancel Then Exit Sub
End If
'PDF speichern
strPfad = Me.TextBoxPDF_Pfad ' ActiveDocument.Path & "\"
strDateiname = Me.TextBoxPDF_Name ' ActiveDocument.Name
strPDF = strPfad & strDateiname
Sheets(Array("Packaging Instruction", "History")).Select
Sheets("Packaging Instruction").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDF, Quality:=xlQualityStandard, _
_
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Packaging Instruction").Select
'Mail in Outlook erstellen
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = strTo 'An-Empfänger
.cc = "" 'Cc-Empfänger
.bcc = "" 'BCc-Empfänger
.Subject = "V" & Range("j3").Text & " " & "Rev. " & Range("W1").Text & " " & "-" & " " & " _
New/Updated Packaging Instruction" 'Betreff
.Body = Range("AE13").Text & vbCrLf & vbCrLf & _
Range("AE14").Text & vbCrLf & _
Range("AE15").Text & vbCrLf & vbCrLf & _
"V" & Range("j3").Text & vbCrLf & _
"Rev. " & Range("W1").Text & vbCrLf & vbCrLf & _
Range("AE16").Text & vbCrLf & _
Range("D35").Text & vbCrLf & _
Range("D36").Text & vbCrLf & vbCrLf & _
Range("AE17").Text & vbCrLf & vbCrLf & _
"" & Range("v6").Text & vbCrLf & vbCrLf & _
"--------------------------------" & vbCrLf & vbCrLf & _
Range("AF13").Text & vbCrLf & vbCrLf & _
Range("AF14").Text & vbCrLf & _
Range("AF15").Text & vbCrLf & vbCrLf & _
"V" & Range("j3").Text & vbCrLf & _
"Rev. " & Range("W1").Text & vbCrLf & vbCrLf & _
Range("AF16").Text & vbCrLf & _
Range("D36").Text & vbCrLf & vbCrLf & _
Range("AF17").Text & vbCrLf & vbCrLf & _
"" & Range("v6").Text
.Attachments.Add strPDF 'Anlage
.Display 'Mail anzeigen
End With
VBA.Kill strPDF 'erstellte PDF-Datei wieder löschen
Set objMail = Nothing
Set objOutlook = Nothing
'Beenden
Unload Me
End Sub