AW: Sheets auswählen dann als PDF speichern
10.02.2019 16:15:00
Nepumuk
Hallo Holly,
teste mal:
Option Explicit
Private Sub CommandButton1_Click()
Dim aobjWorksheets() As Worksheet, objActiveSheet As Worksheet
Dim lngIndex As Long, ialngWorksheetIndex As Long
Dim blnSelectWorksheet As Boolean
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 zum drucken 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:=ThisWorkbook.Path & "\Ausdruck.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True)
Erase aobjWorksheets
objActiveSheet.Select
Set objActiveSheet = Nothing
Application.ScreenUpdating = True
End If
End Sub
Private Sub CommandButton2_Click()
Call Unload(Object:=Me)
End Sub
Private Sub UserForm_Activate()
Dim objWorksheet As Worksheet
With ThisWorkbook
For Each objWorksheet In ThisWorkbook.Worksheets
Select Case objWorksheet.Name
Case "Stammdaten", "Vorlage"
'do nothing
Case Else
If objWorksheet.Visible = xlSheetVisible Then _
Call ListBox1.AddItem(objWorksheet.Name)
End Select
Next
End With
End Sub
Gruß
Nepumuk