AW: Kontrollkästchen in Userform
13.04.2014 17:39:29
Oberschlumpf
Hi Pascal
schreib ins Klick-Ereignis des Buttons diesen Code:
Private Sub cmdPrint_Click()
Dim ctrChk As Control, larstrChk() As String
ReDim larstrChk(0)
For Each ctrChk In Controls
If TypeName(ctrChk) = "CheckBox" Then
If ctrChk.Value = True Then
If larstrChk(0) = "" Then
larstrChk(0) = ctrChk.Name
Else
ReDim Preserve larstrChk(UBound(larstrChk) + 1)
larstrChk(UBound(larstrChk)) = ctrChk.Name
End If
End If
End If
Next
sbPDFPrint larstrChk
End Sub
und schreib in ein allgemeines Modul diesen Code:
Sub sbPDFPrint(chkboxes)
Dim liIdx As Integer, lstrFile As String
For liIdx = 0 To UBound(chkboxes)
'wenn CheckBox für deutsch NICHT "chkGer" heißt, dann anpassen
If chkboxes(liIdx) = "chkGer" Then
lstrFile = Application.GetSaveAsFilename(fileFilter:="PDF Files (*.pdf), *.pdf")
If lstrFile "Falsch" Then
'wenn Tabelle NICHT "Deutsch" heißt, dann anpassen
Sheets("Deutsch").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=lstrFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
End If
'wenn CheckBox für deutsch NICHT "chkFra" heißt, dann anpassen
If chkboxes(liIdx) = "chkFra" Then
lstrFile = Application.GetSaveAsFilename(fileFilter:="PDF Files (*.pdf), *.pdf")
If lstrFile "Falsch" Then
'wenn Tabelle NICHT "Francais" heißt, dann anpassen
Sheets("Francais").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=lstrFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
End If
'wenn CheckBox für deutsch NICHT "chkIta" heißt, dann anpassen
If chkboxes(liIdx) = "chkIta" Then
lstrFile = Application.GetSaveAsFilename(fileFilter:="PDF Files (*.pdf), *.pdf")
If lstrFile "Falsch" Then
'wenn Tabelle NICHT "Italiano" heißt, dann anpassen
Sheets("Italiano").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=lstrFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
End If
Next
End Sub
Ich kann diesen Code nicht testen, da ich noch Excel 2003 benutze, und Excle 2003 kann noch nicht alleine PDFs drucken.
Hilft denn mein Code?
Wenn nicht, kann ich leider nicht weiter helfen, da, wie gesagt, keine Testmöglichkeit.
Ciao
Thorsten
