AW: VBA Druck per Checkbox anfällig
04.11.2016 00:10:57
fcs
Hallo René,
es ist schleierhaft, warum es mit den Checkboxen Probleme geben sollte. Bei mir hat die Datei unter Excel 2010 problemlos funktioniert.
Es ist nicht auszuschließen, dass es Probleme gibt, wenn die Datei in unterschiedlchen Excel-Welten bearbeitet wird. Insbesondere Wechsel zwischen Excel 2003 und alter und Excel 2007 und neuer können dazu führen, das die VBA-Komponenten nicht mehr richtig gefunden/geöffnet werden.
Meistens funktioniert es wieder, wenn man im VBA-Editor die Verweise neu setzt.
Alternativ kann man auch vor den VBA-Befehlen/ethoden ein VBA. einfügen. z.B.
varFilename = VBA.Left(varFilename, VBA.InStrRev(varFilename, ".") - 1)
Dann werden die Makros etwas robuster.
wenn du die "x" in SPalte E hinter den Blattnamen einträgst, muss das Makro etwa wie folgt aussehen.
Gruß
Franz
Sub prcMakePDF()
Dim wksControl As Worksheet
Dim arrSheets() As String, intS As Integer
Dim rngX As Range
Dim varFilename
'Tabellenblatt mit Checkboxen und Schalfläche setzen
Set wksControl = ActiveWorkbook.Sheets(1)
'Prüfen welche Checkboxen gesetzt sind zugehörige Blattnamen in Array sammeln
For Each rngX In wksControl.Range("E33:E44").Cells
If LCase(rngX.Text) = "x" Then
intS = intS + 1
ReDim Preserve arrSheets(1 To intS)
'Zellinhalt in Zelle links von Zelle mit "x" als Tabellennamen einlesen
arrSheets(intS) = rngX.Offset(0, -3).Text
End If
Next rngX
If intS = 0 Then
MsgBox "Es wurden keine Blätter für die PDF-Ausgabe gewählt."
Else
varFilename = ActiveWorkbook.Name
varFilename = Left(varFilename, InStrRev(varFilename, ".") - 1)
varFilename = varFilename & " " & Format(Now, "YYYY-MM-DD hhmmss") & ".pdf"
varFilename = ActiveWorkbook.Path & "\" & varFilename
varFilename = Application.GetSaveAsFilename(InitialFileName:=varFilename, _
Filefilter:="PDF-Dateien (*.pdf),*.pdf)", _
Title:="Speichern unter - Bitte Namen der PDF-Datei eingeben/auswählen", _
ButtonText:="Speichern unter")
If Not varFilename = False Then
Application.ScreenUpdating = False
ActiveWorkbook.Sheets(arrSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=varFilename, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
wksControl.Select
Application.ScreenUpdating = True
End If
End Sub