Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ToggleButton
BildScreenshot zu ToggleButton ToggleButton-Seite mit Beispielarbeitsmappe aufrufen

Schleife und ToggleButton


Betrifft: Schleife und ToggleButton von: Gabi
Geschrieben am: 01.12.2016 23:25:24

Hallo zusammen,

ich sitzte aktuell wieder mal vor einem Problem...

Ich habe eine Dienstplandatei, wobei die Änderungen über die Sub Workbook_SheetChange gelb hinterlegt werden, sodass diese nachvollziehbar sind. Für die Dienstplanerstellung habe ich mittels ToggleButton eingestellt, dass sobald der Planer diesen klickt, die SheetChanges nicht gelb hinterlegt werden. Diese Sub sieht so aus:

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim lngZeile As Long
    Dim ToggleButton1 As ToggleButton

            If ActiveSheet.ToggleButton1.Value = True Then
                If Environ("Username") = "Gabi" Then
                        Application.EnableEvents = False
                            With Worksheets("Benutzeränderungen")
                                lngZeile = .Range("A65536").End(xlUp).Row + 1
                                .Unprotect ("password")
                                .Cells(lngZeile, 1).Value = Environ("UserName")
                                .Cells(lngZeile, 2).Value = Date
                                .Cells(lngZeile, 3).Value = Time
                                .Cells(lngZeile, 4).Value = sh.Name
                                .Cells(lngZeile, 5).Value = Target.Address
                                .Cells(lngZeile, 6).Value = oldValue
                                .Cells(lngZeile, 7).Value = Target.Text
                                .Protect ("password")
                            End With
                        Application.EnableEvents = True
                        Exit Sub
                End If
            End If
    Application.EnableEvents = False
        With Worksheets("Benutzeränderungen")
            lngZeile = .Range("A65536").End(xlUp).Row + 1
                .Unprotect ("password")
                .Cells(lngZeile, 1).Value = Environ("UserName")
                .Cells(lngZeile, 2).Value = Date
                .Cells(lngZeile, 3).Value = Time
                .Cells(lngZeile, 4).Value = sh.Name
                .Cells(lngZeile, 5).Value = Target.Address
                .Cells(lngZeile, 6).Value = oldValue
                .Cells(lngZeile, 7).Value = Target.Text
                .Protect ("password")
        End With
    Target.Interior.ColorIndex = 6
    Application.EnableEvents = True
 End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
   oldValue = Target
End Sub
Zudem habe ich den dem Dienstplan eine Abfrage eingebaut, die sich automatisch öffnet, sobal der Dienstplan geöffnet wird. Diese Abfrage prüft zunächst, welcher Mitarbeiter die Datei Dienstplan geöffnet hat und springt direkt auf die Eingabezelle des Mitarbeiters. Die Besonderheit ist dabei, dass ein Mitarbeiter zwar nur eine Eingabezellen = Telefonzellen pro Tabellenblatt hat, jedoch mehrere Tabellenblätter und somit auch mehrere Eingabezellen existieren, welche mittels Abfrage ausgefüllt werden müssen.
Sub findUserForPhoneTime()  'Öffnet die Mitarbeiterliste und entnimmt den MA-Namen
Application.ScreenUpdating = False
    
    Dim wb1pfad As String
    Dim wb1name As String
    Dim wb2 As Workbook
    Dim wb2pfad As String
    Dim wb2name As String
    Dim wb2ws1 As Worksheet
    Dim wb1ws2 As Worksheet
    Dim bwbopen As Boolean
    Dim activeUser As String
    Dim searchCell As Range
    Dim searchCell1 As Range
    Dim strName As String
    Dim strVorname As String
    Dim AktuellesDatum As Date
    Dim AktuellstesWorksheet As Worksheet
    Dim WS_Count As Integer
    Dim I As Integer

     wb1pfad = "C:\VBA\"
     wb1name = "Dienstplan.xlsm"               ' bereits geöffnete Datei
     wb2pfad = "C:\VBA\"
     wb2name = "Mitarbeiterliste.xlsm"         ' zu öffnende Datei
        bwbopen = WorkbookIsOpen(wb2name)
           If bwbopen = False Then
                   Workbooks.Open (wb2pfad & wb2name)
               Else
           End If
        Set wb1 = Workbooks("Dienstplan.xlsm")
        Set wb2 = Workbooks("Mitarbeiterliste.xlsm")
        Set wb1ws1 = wb1.Worksheets(Worksheets.Count) ' bereits geöffnete Datei
        Set wb2ws1 = wb2.Worksheets("Tabelle1")       ' zu öffnende Datei
        
    activeUser = Environ("UserName")
    
    Debug.Print activeUser
    
    wb2ws1.Activate 'Vergleich in der MA-Liste und Entnahme des richtigen MA-Namen
    For Each searchCell In Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
      If searchCell = activeUser Then
       strName = searchCell.Offset(0, -2) ' 2 Zellen links neben der aktiven Zelle
       strVorname = searchCell.Offset(0, -1) ' 2 Zellen links neben der aktiven Zelle
      End If
    Next
    
    Dim Test1 As String
    Test1 = strVorname & " " & strName
    Debug.Print Test1

For Each wksTabelle In wb1.Sheets
    If wksTabelle.Index > 2 Then
    
    Debug.Print wksTabelle.Name
        With wksTabelle
        For Each searchCell1 In .Range("A3:A" & .Cells(Rows.Count,"A").End(xlUp).Row)
            If searchCell1.Value = strVorname & " " & strName Then
                Set Telefonzelle = searchCell1.Offset(9, 21) 
                
                Debug.Print Telefonzelle
                
                Exit For
            End If
        Next searchCell1
        AktuellesDatum = Format(Now, "DD.MM.YYYY")
            If IsEmpty(Telefonzelle) And .Range("T2") < AktuellesDatum Then
                
                Debug.Print " Telefonzelle leer!"
                Call msgAbfrageTelefonzeit
            End If
        End With
    End If
Next wksTabelle
    wb2.Close
    Application.ScreenUpdating = True

End Sub
und diese Sub für die Abfrage der Telefonzeit:
Sub msgAbfrageTelefonzeit()
    Dim lngZahl As Double
    Dim IsNumeric() As Boolean
    Dim strAntwort As String
    Dim Abfrage As String
    
AnfangAbfrage:
    lngZahl = Application.InputBox(vbNewLine & "Wie viel haben Sie in der " & wksTabelle.Name &  _
_
    " (letzte Woche) telefoniert? Bitte geben Sie dies in einer Dezimalzahl an." & vbNewLine &  _
_
    "Bsp.: 0,75 (= 45 Minuten)" & vbNewLine & vbNewLine, _
    "Telefonzeit-Abfrage", 0, , , Type:=1) 
    
        If lngZahl = 0 Then
        Abfrage = MsgBox("Sind Sie sicher?", vbYesNo)
            If Abfrage = vbNo Then
               GoTo AnfangAbfrage
               Else: wksTabelle.Range(Telefonzelle.Address).Value = "0,00"
            End If
        Else
            MsgBox "Vielen Dank für Ihre Eingabe!", vbOKOnly
            wksTabelle.Range(Telefonzelle.Address).Value = lngZahl
        End If
End Sub
Dabei werden die Variablen Dim wb1 As Workbook und Dim wksTabelle As Worksheet außerhalb der Subs definiert, sodass diese für mehrere Subs verwendet/übergeben werden können.

Das Ausfüllen der Telefonzellen funktioniert zwar, jedoch lediglich bei der Abfrage für das erste Tabellenblatt. Sobald man beim zweiten Tabellenblatt die Abfrage beantwortet und auf ok klickt, erschein die Fehlermeldung: "LAufzeitfehler'438': Objekt unterstützt diese Eigenschaft oder MEthode nicht". Diese Fehlermeldung bezieht sich auf die Zeile "If ActiveSheet.ToggleButton1.Value = True Then" in der Worbkook_SheetChange-Sub.

Hat jemand eine Idee woran das liegen könnte?

Vielen Dank schon mal.

Liebe Grüße Gabi

  

Betrifft: AW: Schleife und ToggleButton von: Mullit
Geschrieben am: 02.12.2016 00:22:06

Hallo,

wenn sich nicht auf jedem TabBlatt ein Togglebutton befindet, würdest Du diesen Fehler erhalten, weil Du mit ActiveSheet referenzierst, Du müsstest also bspw. schreiben:

If Tabelle1.ToggleButton1.Value Then

Gruß, Mullit


  

Betrifft: AW: Schleife und ToggleButton von: Gabi
Geschrieben am: 03.12.2016 09:36:18

Hallo Mullit,

danke für deine Antwort. Es befindet sich aber auf jedem Tabellenblatt ein Togglebutton. Mit Außnahme von dem Tabellenblatt "Benutzeränderungen". Dort ändert aber niemand etwas, da dieses Blatt schreibgeschützt ist. Von dem her müsste ActiveSheet doch stimmen oder nicht?

Liebe Grüße
Gabi


  

Betrifft: AW: Schleife und ToggleButton von: Mullit
Geschrieben am: 03.12.2016 15:52:00

Hallo Gabi,

eigentlich ja, tja, dann mal her mit ner Bsp.-mappe...

Gruß, Mullit


  

Betrifft: AW: Schleife und ToggleButton von: Gabi
Geschrieben am: 04.12.2016 16:13:57

Hallo Mullit,

es war noch ein Tabellenblatt versteckt, was noch keinen ToggleButton hatte. Jetzt funktioniert es. :-) Vielen Dank für deine Hilfe!

Liebe Grüße
Gabi


Beiträge aus den Excel-Beispielen zum Thema "Schleife und ToggleButton"