AW: Array dynamisch bilden
11.07.2012 02:16:06
Franc
puhh ... ist jetzt länger geworden als geplant aber k ^^
Ich bin mir ziemlich sicher das man es auch einfacher lösen kann aber ich bin auch nur VBA Laie bis Anfänger
Das Makro ist nur so lang, weil alle Fehlerquellen abgedeckt sein sollten. Das ganze Makro könnte auch nur 2 Zeilen lang sein aber da geht Komfort und Fehlerprüfung verloren und grad ein Fehler kann zu unerwünschten Ergebnissen führen.
Also - es kommt eine Eingabebox wo bereits alle Tabellennamen mit Leerzeichen getrennt drinstehen. Du kannst die nichterwünschten Blätter mit doppelklick markieren und löschen.
In der Prüfroutine danach werden doppelte Leerzeichen sowie leerzeichen am Anfang und Ende entfernt.
Danach wird das ganze anhand der Leerzeichen die zwischen den Tabellennamen stehen getrennt und ist automatisch ein Array.
Als letztes wird die Eingabe noch mal überprüft indem die einzelnen Tabellennamen im Array mit den Blattnamen verglichen werden. Sollte ein Name nicht vorkommen, wird dieser in einer msgBox angezeigt und entweder gehts wieder zur Eingabe oder das Makro kann da auch abgebrochen werden.
Falls die Eingabe der Tabellennamen anders sein soll einfach schreiben.
Sub pruefen()
Dim iBlatt As Integer, strVorgabe As String
Dim strBlätter As String, arBlätterAuswahl As Variant
Dim iBlatt2 As Integer, blFehler As Boolean
Blattauswahl:
strVorgabe = ""
For iBlatt = 1 To Sheets.Count
strVorgabe = strVorgabe & Sheets(iBlatt).Name & " "
Next
strBlätter = InputBox("Blattnummern eingeben", "Auswahl", strVorgabe)
If strBlätter = "" Then Exit Sub
Do
strBlätter = Replace(strBlätter, " ", " ")
Loop While InStr(strBlätter, " ") > 0
If Right(strBlätter, 1) = " " Then strBlätter = Left(strBlätter, Len(strBlätter) - 1)
If Left(strBlätter, 1) = " " Then strBlätter = Right(strBlätter, Len(strBlätter) - 1)
arBlätterAuswahl = Split(strBlätter, " ")
For iBlatt = 0 To UBound(arBlätterAuswahl)
blFehler = True
For iBlatt2 = 1 To Sheets.Count
If Sheets(iBlatt2).Name = arBlätterAuswahl(iBlatt) Then
blFehler = False
Exit For
End If
Next
If blFehler = True Then
MsgBox "Blatt """ & arBlätterAuswahl(iBlatt) & """ existiert nicht."
GoTo Blattauswahl
'oder
'exit sub
End If
Next
Call SaveAsPDF(varSheets:=Array(arBlätterAuswahl))
End Sub