Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Mehere Sheets auswählen dann als PDF senden

Mehere Sheets auswählen dann als PDF senden
06.03.2019 16:38:43
Holly
Hallo zusammen,
ich habe für mich ein großes Problem denke
für euch ein kleines.
Ich möchte mhere Sheets mit Outlook als PDF senden.
Mit der Aktuellen Seite klappt es, aber nicht mt mehrere.
Ich habe meine Tabelle mit dem Code beigefügt.
Wäre Nett wenn einer sich den Code mal anschaut undmit sagt wo
der Fehler ist.
https://www.herber.de/bbs/user/128146.xlsm
vielen Dank schon mal im voraus
Glück aus aus Witten
Holly
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehere Sheets auswählen dann als PDF senden
06.03.2019 21:29:44
Nepumuk
Hallo Holly,
teste jetzt mal:
Private Sub CommandButton1_Click()
    
    Dim app As Object
    Dim file As String
    Dim isNew As Boolean
    Dim aobjWorksheets() As Worksheet, objActiveSheet As Worksheet
    Dim lngIndex As Long, ialngWorksheetIndex As Long
    Dim blnSelectWorksheet As Boolean
    
    file = "Dienstplan Aushang.pdf"
    
    With ListBox1
        For lngIndex = 0 To .ListCount - 1
            If .Selected(lngIndex) Then
                Redim Preserve aobjWorksheets(ialngWorksheetIndex)
                Set aobjWorksheets(ialngWorksheetIndex) = ThisWorkbook.Worksheets(.List(lngIndex))
                ialngWorksheetIndex = ialngWorksheetIndex + 1
                blnSelectWorksheet = True
            End If
        Next
    End With
    If Not blnSelectWorksheet Then
        Call MsgBox("Bitte wählen Sie eine Tabelle aus.", vbExclamation, "Hinweis")
    Else
        Application.ScreenUpdating = False
        Set objActiveSheet = ActiveSheet
        For ialngWorksheetIndex = 0 To UBound(aobjWorksheets)
            Call aobjWorksheets(ialngWorksheetIndex).Select(Replace:=ialngWorksheetIndex = 0)
        Next
        Call ActiveSheet.ExportAsFixedFormat(Type:=xlTypePDF, _
            Filename:=Environ$("TEMP") & "\" & file, _
            Quality:=xlQualityStandard, IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False)
        
        Set app = GetObject(, "Outlook.Application")
        If app Is Nothing Then
            Set app = CreateObject("Outlook.Application")
            isNew = True
        End If
        
        With app.CreateItem(0)
            .To = "Holger-Schremb@web.de" & ";" 'Die E-Mail-Adresse wurde aus Datenschutzgründen entfernt. ***
            .CC = ""
            .BCC = ""
            .Subject = "Anlage: " & file
            
            .Body = "Sehr geehrte Damen und Herren." & vbCr _
                & vbCr _
                & "Anbei das Excel-Dokument als PDF." & vbCr _
                & vbCr _
                & "Mit freundlichen Grüßen."
            
            .Attachments.Add Environ$("TEMP") & "\" & file
            .ReadReceiptRequested = True 'Lesebestätigung ein
            .Display 'Email anzeigen
            
        End With
        
        If isNew Then app.Quit
        
        Call Kill(PathName:=Environ$("TEMP") & "\" & file)
        
        objActiveSheet.Select
        
        Set app = Nothing
        Set objActiveSheet = Nothing
        
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: Mehere Sheets auswählen dann als PDF senden
07.03.2019 05:22:46
Holly
Hallo Nepumuk und Dieter,
vielen Dank für eure Hilfe,
der Code von Nepumuk läuft SUPER.

Glück auf aus Witten
Holly
AW: Mehere Sheets auswählen dann als PDF senden
06.03.2019 21:31:03
Dieter
Hallo Holly,
versuch es mal folgendermaßen:
Sub Test()
Dim PDF As String
Dim wb As Workbook
Set wb = ThisWorkbook
PDF = wb.Path & "\Dienstplan Aushang.pdf"
wb.Sheets(Array("Vorlage", "KW 10", "KW 9")).Select
wb.Sheets("Vorlage").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PDF, _
OpenAfterPublish:=False
End Sub
mfg
Dieter
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige