1.7k Aufrufe
Gefragt in Tabellenkalkulation von
Moin zusammen,
ich habe folgenden Quellcode für ein VBA, welches soweit auch super funktioniert, leider ist die übergabe der Tabellennamen, welche selectiert werden statisch, dass heisst, ich muss diese in den Quelltext eingeben, besteht die Möglichkeit, diese aus einer Zeile, z.B. A1 udn A2 etc auszulesen?
Wie kann ich außerdem abfangen, wenn nur die Tabelle mit dem Namen aus A1 gedruckt werden soll und in A 2 nichts steht?

Der Code funktioniert soweit, lediglich hierbei bräuchte ich Hilfe

Sheets(Array("Tab1", "Tab2")).Select
ActiveWindow.SelectedSheets.PrintOut


Bitte helft mir,

vielen Dank

Jonsennn

8 Antworten

0 Punkte
Beantwortet von
Hallo Jonsennn,
meinst du so etwas?
If IsEmpty(ActiveSheet.Range("A2")) Then
Worksheets(Range("A1").Value).Select
Else
Worksheets(Array(Range("A1").Value, Range("A2").Value)).Select
End If

Gruss Rolf
0 Punkte
Beantwortet von
Moin, erst einmal danke,leider taucht hier der Fehler auf, Index außerhalb des gültigen Bereiches, ich habe jetzt in Feld A1 den Namen des zu selectierenden Sheets geschrieben (Tab1).

Was mache ich falsch, auch hätte ich gerne von A1 bis A5 die Möglichkeit Namen von zu selectierenden Tabellenblättern einzugeben.
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all ^^

der fehler ist eindeutig

text in der zelle existiert nicht als worksheetname

zu vermeiden waere er mit einer abfrage ob das worksheet tatsaechlich existiert

z.b.

Sub DeinMakro()
If SheetExists(ActiveSheet.Range("A2")) = True Then
Worksheets(Range("A1").Value).Select
End If
End Sub

Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(strName) Is Nothing
End Function
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all ^^

war nur ein tip,ich uebergebe wieder an Rolf

gruss nighty
0 Punkte
Beantwortet von
Hallo again,
ich muß nighty zustimmen.
Hier, auf deine neuen Anforderungen abgestimmten Code:
Dim strTab As String
Dim rgEintrag As Range, rg As Range
Dim varSplit As Variant

Set rgEintrag = ActiveSheet.Range("A1:A5") ' denn Bereich "A1:A5" kannst du anpassen
For Each rg In rgEintrag
If Not IsEmpty(rg) Then
If SheetExists(rg.Value) Then
strTab = strTab & IIf(Len(strTab) > 0, ";", "") & rg.Value
End If
End If
Next rg
If Len(strTab) > 0 Then
varSplit = Split(strTab, ";")
Worksheets(varSplit).Select
Else
MsgBox "Der angegebene Bereich enthält keinen gültigen Blattnamen", vbInformation
End If

Die Function SheetExists kannst du von nighty übernehmen.

Gruss Rolf
0 Punkte
Beantwortet von
Super vielen Dank,

funktioniert soweit, solange die Funktion auf dem Tab1ausgeführt wird.
Leider durchläuft das VBA mehrere Module, d.h. in dem Moment, wo die Sachen übergeben werden befinde ich mich z.B. auf Tab 2 und nicht auf Tab 1. Besteht die möglichkeit, auf fixe Bezüge bzgl des tabellenblattes zu wechseln ( Die Namen der Sheets stehen auf Tab 1 in A1 bis A5, während die Prozedur ausgeführt wird, bin ich wie gesagt leider auf einem anderen Tabellenblatt

Private Sub CommandButton1_Click()


ActiveSheet.Calculate
Dim strTab As String
Dim rgEintrag As Range, rg As Range
Dim varSplit As Variant

Set rgEintrag = ActiveSheet.Range("A1:A5") ' denn Bereich "A1:A5" kannst du anpassen
For Each rg In rgEintrag
If Not IsEmpty(rg) Then
If SheetExists(rg.Value) Then
strTab = strTab & IIf(Len(strTab) > 0, ";", "") & rg.Value
End If
End If
Next rg
If Len(strTab) > 0 Then
varSplit = Split(strTab, ";")
Worksheets(varSplit).Select
Else
MsgBox "Der angegebene Bereich enthält keinen gültigen Blattnamen", vbInformation
End If
End Sub

Danke für eure Mühe!
0 Punkte
Beantwortet von
Hallo again,
die Function SheetExists muß in ein allgemeines Modul(z.B. Modul1).
Sie darf nicht unter dem Tabellenblatt stehen!

Gruss Rolf
0 Punkte
Beantwortet von
Moin,

danke hat soweit mit ein paar kleinen Anderungen geklappt,
nun allerdings arbeitet er die Tabellennachher beim drucken nicht von A1 bis A5 ab, sondern von links nach rechts in der Datei, besteht dort eine Möglichkeit, nach der Auswahl zu gehen?

Danke!!!!!!!!!!!!
...