Hallo zusammen,
ich bin echt verzweifelt, ich komme seit Tagen nicht weiter. Habe schon vieles probiert, was mich aber auch nicht zum Erfolg geführt hat.
Ich verwende Microsoft Excel 2010 VBA.
Zur Anwendung:
Ich möchte über eine Userform dem Anwender in einem Frame über 5 Checkboxen auswählen lassen, welche Blätter gedruckt, in PDF gespeichert oder beides werden sollen.
Soweit so gut. Ich bekomme die Auswahl hin, kann aber leider diese spezielle Auswahl nicht in Sheets(Array("...", "...", "...").Copy hinein, um das letztlich abzuspeichern.
Ich weiß echt nicht weiter. Sofern ich in Sheets(Array("Tabelle1", "Tabelle2")) händisch hineinschreibe geht es. Das brauche ich aber nicht, da der Anwender die Auswahl ja manuell über die Checkboxen ändern kann.
Hier mal mein Code. Ich hoffe mir kann jemand helfen.
Public Sub ArrayFüllen_chkMaschinenkarte()
'Ein Array deklarieren mit i Einträgen (maximal von 0 bis 4, minimal 0)
Dim i, j, k, l As Long
Dim Anzahl As Long
i = 0 'Initialisieren
j = 0
VariableBlätter = ""
'** Festlegen, welche Tabellenblätter gedruckt werden sollen, nur die mit Haken
If UFDrucken.chkDeckblatt.Value = True Then
Drucksammlung(0) = "Sprachen" 'Deckblatt einfügen
Else
Drucksammlung(0) = "" 'Bei Wiederabwahl, Wert nicht immer speichern
End If
If UFDrucken.chkTermine.Value = True Then
Drucksammlung(1) = "Tabelle1" ' Termine einfügen
Else
Drucksammlung(1) = "" 'Bei Wiederabwahl, Wert nicht immer speichern
End If
If UFDrucken.chkStandard.Value = True Then
Drucksammlung(2) = "Tabelle2" 'Standardbaugruppen einfügen
Else
Drucksammlung(2) = "" 'Bei Wiederabwahl, Wert nicht immer speichern
End If
If UFDrucken.chkOptionen.Value = True Then
Drucksammlung(3) = "Optionen" 'Optionsbaugruppen einfügen
Else
Drucksammlung(3) = "" 'Bei Wiederabwahl, Wert nicht immer speichern
End If
If UFDrucken.chkTypenschild.Value = True Then
Drucksammlung(4) = "Typenschild" 'Typenschild einfügen
Else
Drucksammlung(4) = "" 'Bei Wiederabwahl, Wert nicht immer speichern
End If
If Join(Drucksammlung, "") = "" Then 'Prüfen, ob alle Teile des Arrays leer sind, Eingabe erforderlich
MsgBox "So geht das nicht, bitte mindestens eine Auswahl treffen!"
Else
MsgBox "Danke für die Eingabe" 'Wenn irgendeiner gefüllt, weiter
End If
'Umschichtung des Eingabearrays = Drucksammlung in SammlungOhneLeerzeichen, wo von oben her
'die Zeilen mit Eintrag untereinader geschrieben werden, damit nur diese auch gedruckt werden können.
ReDim SammlungOhneLeerzeilen(UBound(Drucksammlung)) 'Dimension von Drucksammlung zuweisen und Inhalt löschen
For i = 0 To UBound(Drucksammlung)
If Drucksammlung(i) <> "" Then 'Wenn keine Leerzeile, dann Wert übernehmen
SammlungOhneLeerzeilen(j) = Drucksammlung(i)
VariableBlätter = VariableBlätter & Chr(34) & SammlungOhneLeerzeilen(j) & Chr(34) & ", "
MsgBox VariableBlätter
j = j + 1
End If
Next i
ReDim Preserve SammlungOhneLeerzeilen(j) 'neue Dimension von SammlungOhneLeerzeilen festlegen
Anzahl = Len(VariableBlätter) 'Bestimmung der Länge des Strings
MsgBox Anzahl
VariableBlätter = Left(VariableBlätter, Anzahl - 2) 'Löschen des letzten Kommatas
MsgBox VariableBlätter & " " & Len(VariableBlätter)
End Sub
Public Sub PDFundDrucken()
Dim SpeicherName As String
Dim SpeicherPfad As String
'Speichername und SpeicherPfad angeben, wo normalerweise gespeichert wird
SpeicherName = InputBox("Wie soll die Datei heißen?", "Speichername angeben", "A")
' Sheets(Array("Tabelle1", "Tabelle2", "Sprachen")).PrintOut
' On Error GoTo Fehler
'Abfrage des Speicherpfades --> Speichern unter
If MsgBox(prompt:="Möchten Sie das Arbeitsblatt nun speichern?", Buttons:=vbYesNo _
+ vbQuestion, Title:="Speichern?") = vbNo Then Exit Sub
SpeicherPfad = Application.GetSaveAsFilename( _
InitialFileName:="O:\" & SpeicherName, _
fileFilter:="PDF-Datei (*.pdf),*.pdf", _
Title:="Speicherpfad auswählen oder eingeben")
'Übertragung des gewünschten Speichernamens, des gewünschten Dateiformates und Titel des Fensters
If SpeicherPfad = "Falsch" Then
MsgBox "Kein Pfad zum Speichern angegeben"
Exit Sub
End If
MsgBox SpeicherPfad & " ist der Pfad und der Name ist " & SpeicherName
Sheets(Array(SammlungOhneLeerzeilen)).Copy
'hier müssen eigentlich noch NUR die über die Checkboxes angewählten Optionen hinein, wie?
With ActiveWorkbook
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SpeicherName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=True
.Close SaveChanges:=False
End With
Exit Sub
'Fehler:
MsgBox "Da hat wohl was nicht ganz funktioniert", vbInformation
End Sub
|