VBA: OptionButton (With/If/Case)
19.06.2019 05:11:00
Charly
ich habe ein Problem mit OptionButton.
Mappe(1) mit UF:
OptionButtonen
ComboBox(RowSource hinterlegt)
TextBoxen, nur zur Darstellung von Inhalten, keine Schreiben
CommandButto´s
Mappe(3) ist eine Vorlage, für die TextBox/Inhalt
Wenn Ich in Mappe(1) per Button(1) meine UF Öffne u. per ComboBox einen Wert wähle werden daraufhin mehrere Mappen geöffnet u. die UF ließt festgelegte Werte aus den Mappen in die TextBoxen.
Dann wird per Button2 eine weitere Mappe(3) geöffnet "die Vorlage", alle Inhalte der TextBoxen werden hier zusammengefast u. in dafür vorgesehene Zellen eingetragen.
Über Button3 wird gespeichert Pfad u. Name der Datei sind im Code des Button3 hinterlegt.
Mein Problem,
Ich möchte über OptionButton´s eine Art vorauswall des Speicherpfades festlegen.
OB1 = Ordner(Gruppe1) in diesem sind OB3 = Ordner(1), OB4 = Ordner(2), OB5 = Ordner(3)
OB2 = Ordner(Gruppe2) in diesem sind OB3 = Ordner(1), OB4 = Ordner(2), OB5 = Ordner(3)
Meine alten Codezeilen ohne OptionButton funktioniert, habe Ich aus dem Forum u. etwas Angepasst mit With u. If Schleife
http://www.office-loesung.de/ftopic500064_0_0_asc.php
Mit den OptionButton kommt jetzt eine Fehlermeldung:
Fehler beim Kompilieren
Anweisungen und Zeilenmarken zwischen Select Case und erstem Vorkommen von Case unzulässig.
Wie od. was muss Ich am Code ändern um mein Vorhaben umzusetzen.
Hier mein Code:
Private Sub CommandButton1_Click()
Dim Datei As String, Verzeichnis As String, SaveDummy As Variant, wkb As Workbook
'Mappe ist bereits per UF geöffnet worden
Workbooks("Mappe(3).xlsx").Sheets("Tabelle1").Activate
Range("A1").Select
With Speichern
If Me.OptionButton1 = True Then
Select Case Me.OptionButton1
If Me.OptionButton1 = True Then
Select Case Me.OptionButton3
Verzeichnis = "P:\Gruppe1\1\"
Datei = TB_Dateiname.Value & ".xlsx"
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy
Range("A1").Select
Workbooks("Mappe(1).xlsm").Sheets("Tabelle1").Activate
End Select
ElseIf Me.OptionButton1 = True Then
Select Case Me.OptionButton4
Verzeichnis = "P:\Gruppe1\2\"
Datei = TB_Dateiname.Value & ".xlsx"
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy
Range("A1").Select
Workbooks("Mappe(1).xlsm").Sheets("Tabelle1").Activate
End Select
ElseIf Me.OptionButton1 = True Then
Select Case Me.OptionButton5
Verzeichnis = "P:\Gruppe1\3\"
Datei = TB_Dateiname.Value & ".xlsx"
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy
Range("A1").Select
Workbooks("Mappe(1).xlsm").Sheets("Tabelle1").Activate
End Select
Else
MsgBox "Wählen Sie eine Option (Ordner)!"
End If
End Select
ElseIf Me.OptionButton2 = True Then
Select Case Me.OptionButton2
If Me.OptionButton2 = True Then
Select Case Me.OptionButton3
Verzeichnis = "P:\Gruppe2\1\"
Datei = TB_Dateiname.Value & ".xlsx"
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy
Range("A1").Select
Workbooks("Mappe(1).xlsm").Sheets("Tabelle1").Activate
End Select
ElseIf Me.OptionButton2 = True Then
Select Case Me.OptionButton4
Verzeichnis = "P:\Gruppe2\2\"
Datei = TB_Dateiname.Value & ".xlsx"
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy
Range("A1").Select
Workbooks("Mappe(1).xlsm").Sheets("Tabelle1").Activate
End Select
ElseIf Me.OptionButton2 = True Then
Select Case Me.OptionButton5
Verzeichnis = "P:\Gruppe2\3\"
Datei = TB_Dateiname.Value & ".xlsx"
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy
Range("A1").Select
Workbooks("Mappe(1).xlsm").Sheets("Tabelle1").Activate
End Select
Else
MsgBox "Wählen Sie eine Option (Ordner)!"
End If
End Select
Else
MsgBox "Wählen Sie eine Option (Grund)!"
End If
End With
For Each wkb In Workbooks
If (wkb.Name ActiveWorkbook.Name) And (wkb.Name ThisWorkbook.Name) Then
Application.DisplayAlerts = False
wkb.Close savechanges:=False
Application.DisplayAlerts = True
End If
Next wkb
End Sub
Function SpeichernUnter(VorgabeName As String) As Variant
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, _
Filefilter:=" _Excel Dateien (*.xlsx),*.xls*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
End Function
Gruß Charly