Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Fehler bei Ausdruck aus Formular

Betrifft: Fehler bei Ausdruck aus Formular von: Kai Thomas
Geschrieben am: 25.07.2014 03:42:10

Hallo zusammen,

nachlängerer Zeit kann ich mich nun mal wieder intensiver um meine Excel Tabellen kümmern und sitze hier vor einem Problem, bei dem ich nach googeln und probieren zu keiner Lösung finde.

Mir wurde 2008 mal in diesem Thread geholfen: https://www.herber.de/forum/archiv/1020to1024/t1022366.htm

Ich verwende in einer anderen Tabelle nun folgendes Makro:

Private Sub UserForm_Activate()
  Dim sh As Worksheet
  For Each sh In Sheets
    sh.Visible = True
    sh.Unprotect "test"
    sh.Activate
  Next sh
End Sub

Private Sub CommandButton1_Click()
Dim lngI As Long
Dim arrSheets() As Variant, varhelp As Variant
Dim sh As Worksheet

lngI = 0
If CheckBox1 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Summe"
lngI = lngI + 1
End If
If CheckBox2 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Schiedsrichter"
lngI = lngI + 1
End If
If CheckBox3 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Wäsche"
lngI = lngI + 1
End If
If CheckBox4 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Summe Fahrtkosten"
lngI = lngI + 1
End If
If CheckBox5 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Fahrtkosten"
lngI = lngI + 1
End If
If CheckBox6 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Turnierkosten Porto etc. Druck"
lngI = lngI + 1
End If
If CheckBox7 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Mannschaftskasse"
lngI = lngI + 1
End If
If CheckBox9 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Helfer-Fahrer-Liste Trainer"
lngI = lngI + 1
End If
If CheckBox8 = True Then
ReDim Preserve arrSheets(lngI)
arrSheets(lngI) = "Helfer-Fahrer-Liste Eltern"
lngI = lngI + 1
End If

On Error Resume Next
varhelp = arrSheets(0)
If Err.Number = 0 Then
Sheets(arrSheets).Select
Application.Dialogs(xlDialogPrint).Show
Else
MsgBox "Sie haben keine Tabelle ausgewählt !", vbCritical, " Keine Auswahl"
End If
On Error GoTo 0
Call Ausdruck.Hide

Worksheets("Turnierkosten Porto etc. Druck").Visible = False
Worksheets("Schiedsrichter").Visible = False
Worksheets("Wäsche").Visible = False
Worksheets("Summe Fahrtkosten").Visible = False
Worksheets("Summe").Visible = False
Worksheets("Fahrtkosten").Visible = False
Worksheets("Helfer-Fahrer-Liste Eltern").Visible = False

For Each sh In Sheets
sh.Protect "test"
Next sh

Sheets("Daten").Select
End Sub

Wenn eine Checkbox ausgewählt wird, läuft alles, ebenso wenn 3 oder mehr ausgewählt werden.

Wenn allerdings 2 ausgewählt werden kommt es zu einem Fehler.
Die Unprotect-Methode des Worksheet-Objektes konnte nicht ausgeführt werden.

Sicherlich ist die Lösung mit activate nicht gerade super um die einzelnen Makros der Tabellenblätter auszuführen, allerdings funktioniert es..., nur mit 2 ausgewählten Checkboxen nicht, was mich irritiert.

Für hilfreiche Ideen bin ich dankbar.

Viele Grüße

Kai

  

Betrifft: AW: Fehler bei Ausdruck aus Formular von: fcs
Geschrieben am: 25.07.2014 12:02:46

Hallo Kai,

dass dies Problem nur bei 2 markierten Textboxen auftritt muss irgend ein systematischer Zufall sein.
Das Aktivieren/Deaktivieren des Blattschutzes funktioniert nur, wenn keine Blätter gruppiert sind.
Deshalb musst du vor dem Änderm des Blattschutzes sicherstellen, dass keine Bläter gruppiert sind.

Dies erreicht man mit der Anweisung
ActiveSheet.Select

Zusatz:
Die Prüfung vor dem Drucken, ob per Checkbox Blätter gewählt worden sind kannst du einfacher gestalten.
Du musst nur prüfen, ob die Varaible lngI > 0 ist.


Gruß
Franz

Private Sub UserForm_Activate()
  Dim sh As Worksheet
 'ggf. Gruppierung der Blätter aufheben
  ActiveSheet.Select
  For Each sh In Sheets
    sh.Visible = True
    sh.Unprotect "test"
    sh.Activate
  Next sh
End Sub



Private Sub CommandButton1_Click()

  Dim lngI As Long
  
  Dim arrSheets() As Variant
  
  Dim sh As Worksheet
  
  lngI = 0
  
  If CheckBox1 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Summe"
      lngI = lngI + 1
  End If
  
  If CheckBox2 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Schiedsrichter"
      lngI = lngI + 1
  End If
  
  If CheckBox3 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Wäsche"
      lngI = lngI + 1
  End If
  
  If CheckBox4 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Summe Fahrtkosten"
      lngI = lngI + 1
  End If
  
  If CheckBox5 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Fahrtkosten"
      lngI = lngI + 1
  End If
  
  If CheckBox6 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Turnierkosten Porto etc. Druck"
      lngI = lngI + 1
  End If
  
  If CheckBox7 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Mannschaftskasse"
      lngI = lngI + 1
  End If
  
  If CheckBox9 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Helfer-Fahrer-Liste Trainer"
      lngI = lngI + 1
  End If
  
  If CheckBox8 = True Then
      ReDim Preserve arrSheets(lngI)
      arrSheets(lngI) = "Helfer-Fahrer-Liste Eltern"
      lngI = lngI + 1
  End If
  
  If lngI > 0 Then
      Sheets(arrSheets).Select
      Application.Dialogs(xlDialogPrint).Show
  Else
      MsgBox "Sie haben keine Tabelle ausgewählt !", vbCritical, " Keine Auswahl"
  End If
  
  ActiveSheet.Select 'Gruppierung nach dem Drucken aufheben
  
  Call Ausdruck.Hide
  
  
  Worksheets("Turnierkosten Porto etc. Druck").Visible = False
  
  Worksheets("Schiedsrichter").Visible = False
  
  Worksheets("Wäsche").Visible = False
  
  Worksheets("Summe Fahrtkosten").Visible = False
  
  Worksheets("Summe").Visible = False
  
  Worksheets("Fahrtkosten").Visible = False
  
  Worksheets("Helfer-Fahrer-Liste Eltern").Visible = False
  
  For Each sh In Sheets
      sh.Protect "test"
  Next sh
  
  Sheets("Daten").Select
End Sub



  

Betrifft: AW: Fehler bei Ausdruck aus Formular von: Kai Thomas
Geschrieben am: 25.07.2014 18:52:37

Hallo Franz,

vielen Dank für die Hilfe, es funktioniert! :-)

Vielen Dank auch für die hilfreichen Erklärungen!

Gruß Kai


 

Beiträge aus den Excel-Beispielen zum Thema "Fehler bei Ausdruck aus Formular"