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 TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Workbook_open Makro wird nicht richtig ausgeführt


Betrifft: Workbook_open Makro wird nicht richtig ausgeführt von: Dominik
Geschrieben am: 10.08.2016 10:32:34

Hallo,

ich habe in Excel ein Formular erzeugt und ein Makro, welches beim Öffnen der Datei eine Liste mit Optionen ausliest und für jede Option eine Checkbox im Formular erzeugt und generell das Formular zurücksetzt.

Das funktioniert soweit auch, bis auf das benennen der Checkboxen. Anstatt des unter der ".Name" Methode angegebenen Namens bekommen die ersten 33 Checkboxen den Namen "CheckBox1-66". Führe ich das Makro manuell über den VBA-Editor aus, funktioniert alles korrekt. Ich kann mir dieses Verhalten mittlerweile nicht mehr erklären.

Dazu habe ich folgendes Makro, welches mit einem Workbook_open() Event getriggert wird.

  • Public Sub Clr_form()
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
    
        Dim oleObj As OLEObject
        Dim Top As Long, Left As Long
        Dim i As Long
        
        Top = 155
        Left = 140
    
        With Sheets("Formular")
    
            For Each oleObj In .OLEObjects
                If TypeName(oleObj.Object) = "CheckBox" And (InStr(oleObj.Name, "cb_Option_") Or  _
    InStr(oleObj.Name, "CheckBox")) Then
                    oleObj.Delete
                ElseIf TypeName(oleObj.Object) = "TextBox" And (InStr(oleObj.Name, "tb_Option_") Or  _
    InStr(oleObj.Name, "TextBox")) Then
                    oleObj.Delete
                End If
            Next
        
            .lb_ComboBox1.Value = ""
            .lb_ComboBox2.Value = ""
            .lb_ComboBox3.Value = ""
            .tb_TextBox1.Value = ""
            .tb_TextBox2.Value = ""
            .tb_TextBox3.Value = ""
            .tb_TextBox4.Value = ""
            .tb_TextBox5.Value = ""
            .tb_TextBox6.Value = ""
            .tb_TextBox7.Value = ""
    
            For i = .Cells(Rows.Count, 2).End(xlUp).row To 10 Step -1
                If .Cells(i, 2) = "Belegt" Then
                    .Cells(i, 2).EntireRow.Delete
                End If
            Next
    
            For Each oleObj In .OLEObjects
                If TypeName(oleObj.Object) = "CheckBox" And InStr(oleObj.Name, "cb_Option") Then
                    oleObj.Object.Value = False
                End If
            Next
        
         End With
        
        For i = 2 To Sheets("Checkbox Daten").Cells(Rows.Count, 1).End(xlUp).row
            If i - 1 = 1 Then
                Sheets("Formular").Cells(9 + i - 2, 4) = "Text1"
                Sheets("Formular").Cells(9 + i - 2, 8) = Sheets("Checkbox Daten").Cells(i, 3)
            Else
                Sheets("Formular").Cells(9 + i - 2, 1).EntireRow.Insert
                Sheets("Formular").Cells(9 + i - 2, 4) = "Text1"
                Sheets("Formular").Cells(9 + i - 2, 8) = Sheets("Checkbox Daten").Cells(i, 3)
                Sheets("Formular").Rows("9:9").Copy
                Sheets("Formular").Rows(9 + i - 2 & ":" & 9 + i - 2).PasteSpecial Paste:= _
    xlPasteFormats
                Sheets("Formular").Cells(9 + i - 2, 2) = "Belegt"
            End If
    
        With Sheets("Formular").OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
           DisplayAsIcon:=False, Left:=147, Top:=198, Width:=108, Height:=21)
            .Name = "cb_Option_name_" & i - 1
            .Object.Caption = "Option " & Sheets("Checkbox Daten").Cells(i, 2)
            .Object.Value = False
            .Width = Len(.Object.Caption) * 9
            .Left = Left
            .Top = Top + (i - 2) * 22.5
        End With
        
        With Sheets("Formular").OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
           DisplayAsIcon:=False, Left:=147, Top:=198, Width:=30, Height:=21)
            .Enabled = False
            .Object.BackColor = RGB(190, 190, 190)
            .Name = "tb_Option_rev_" & i - 1
            .Left = 317.25
            .Top = Top + (i - 2) * 22.5
        End With
        
        With Sheets("Formular").OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
           DisplayAsIcon:=False, Left:=147, Top:=198, Width:=30, Height:=21)
            .Name = "cb_Option_new_" & i - 1
            .Object.Caption = "Aktuelle Revision"
            .Object.Value = True
            .Width = Len(.Object.Caption) * 6
            .Left = 394
            .Top = Top + (i - 2) * 22.5
        End With
        
        Next
    
        Application.OnTime Now + TimeValue("00:00:01"), "set_rev_boxes"
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = xlCalculationAutomatic
        End With
    
    End Sub

  •   

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Mullit
    Geschrieben am: 11.08.2016 07:36:19

    Hallo,

    ich habs mal mit dem entsch. Part auch in xl2010 getestet, das läuft bei mir ohne Probleme, was kommt da bei Dir raus, wenn Du die Bsp.-Datei öffnest?

    https://www.herber.de/bbs/user/107544.xlsm

    Gruß, Mullit


      

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Dominik
    Geschrieben am: 11.08.2016 12:03:12

    Hallo,

    nein, auch hier benennt er die Objekte erst ab Objekt 9/10 korrekt. Davor haben die Objekte die Standardnamen "TextBox.." und "CheckBox..". Starte ich den Code jedoch manuell, so passt alles.

    Ich glaube ich habe diese Probleme erst seit kurzem, wüsste aber nicht welche Einstellung ich verändert haben könnte, die das beeinflusst.

    Mfg


      

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Mullit
    Geschrieben am: 11.08.2016 12:39:09

    Hallo,

    hmm, vielleicht gehen noch zwei andere Sachen, entweder Du packst ein DoEvents in Dein Open-Event, oder Du lagerst das ganze in einen Timer aus:

    Option Explicit
    
    Private Sub Workbook_Open()
    Call Application.OnTime(EarliestTime:=Now, Procedure:="prcAddBoxes")
    End Sub

    Option Explicit
    
    Public Sub prcAddBoxes()
    Dim oleObj As OLEObject
    Dim lngTop As Long, lngLeft As Long
    Dim lngIndex As Long
    
    Application.ScreenUpdating = False
    lngTop = 155
    lngLeft = 140
        
    With ThisWorkbook
        For Each oleObj In .Worksheets("Sheet1").OLEObjects
               If TypeName(oleObj.Object) = "CheckBox" And (InStr(oleObj.Name, "cb_Option_") Or _
                      InStr(oleObj.Name, "CheckBox")) Then
                   oleObj.Delete
               ElseIf TypeName(oleObj.Object) = "TextBox" And (InStr(oleObj.Name, "tb_Option_") Or _
                      InStr(oleObj.Name, "TextBox")) Then
                   oleObj.Delete
               End If
        Next
            
        For lngIndex = 2 To 20
            
          With .Worksheets("Sheet1").OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
               DisplayAsIcon:=False, Left:=147, Top:=198, Width:=30, Height:=21)
                .Enabled = False
                .Object.BackColor = RGB(190, 190, 190)
                .Name = "tb_Option_rev_" & lngIndex - 1
                .Left = 317.25
                .Top = lngTop + (lngIndex - 2) * 22.5
          End With
          With .Worksheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
               DisplayAsIcon:=False, Left:=147, Top:=198, Width:=30, Height:=21)
                .Name = "cb_Option_new_" & lngIndex - 1
                .Object.Caption = "Aktuelle Revision"
                .Object.Value = True
                .Width = Len(.Object.Caption) * 6
                .Left = 394
                .Top = lngTop + (lngIndex - 2) * 22.5
          End With
          
        Next
    End With
    End Sub




    VBA/HTML - CodeConverter für Office-Foren
    AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
    Projektbetreuung durch mumpel



    Code erstellt und getestet in Office 14

    Gruß, Mullit


      

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Anton
    Geschrieben am: 11.08.2016 12:59:22

    Hallo Dominik,

    Ich glaube ich habe diese Probleme erst seit kurzem ...
    Nur eine Vermutung: irgendein Excel Add-In installiert(aktiviert)?

    mfg Anton


      

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Dominik
    Geschrieben am: 12.08.2016 09:26:14

    @Mullit
    Das bewirkt leider auch keine Änderung. Es scheint wirklich an meiner Excel Einrichtung zu liegen.

    @Anton
    Ich habe nichts bewusst aktiviert. Aktiviert ist momentan "IXOS_OfficeAddIn", "OfficeLink" und "Sharing Add-in for Microsoft Lync 2010"

    Könnte es mit aktivierten Verweisen zusammenhängen? Dort sind die Verweise "Visual Basic For Applications", "Microsoft Excel 14.0 Object Library", "OLE Automation", "Microsoft Office 14.0 Object Library" und "Microsoft Forms 2.0 Object Library" aktiviert.

    Ich werde es am Montag nochmal auf einem anderen Computer ausprobieren.

    Mfg


      

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Dominik
    Geschrieben am: 15.08.2016 09:08:53

    Hallo nochmal,

    leider funktioniert das Makro auch an einem anderem Computer nicht korrekt.

    Mir ist heute noch aufgefallen, dass der Name im "Namenfeld" des Tabellenblattes korrekt angezeigt wird. Im VBA-Eigenschaften Fenster wird allerdings weiterhin "CheckBoxXX" angezeigt. Ich habe euch mal ein Bild angehängt



    Mfg


      

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Mullit
    Geschrieben am: 15.08.2016 10:44:16

    Hallo,

    ah ja, jetzt kommen wir der Sache näher, der Effekt dürfte daran liegen, daß Excel während des Löschens oder Einfügens von ActiveX-Controls in den Entwurfsmodus wechselt, da funktioniert die Umbenennung nicht korrekt, die mußt Du extra nochmal mit einem Timer von der Einfügenoperation entkoppeln:

    Option Explicit
    
    Private Sub Workbook_Open()
    Call Application.OnTime(EarliestTime:=Now, Procedure:="prcAddBoxes")
    End Sub

    Option Explicit
    
    Public Sub prcAddBoxes()
    Dim objOLEObject As OLEObject
    Dim lngTop As Long, lngLeft As Long
    Dim lngIndex As Long
    
    Application.ScreenUpdating = False
    lngTop = 155
    lngLeft = 140
        
    With ThisWorkbook
        For Each objOLEObject In .Worksheets("Sheet1").OLEObjects
            With objOLEObject
                 If TypeName(.Object) = "CheckBox" And (InStr(.Name, "cb_Option_") Or _
                        InStr(.Name, "CheckBox")) Then
                     Call .Delete
                 ElseIf TypeName(.Object) = "TextBox" And (InStr(.Name, "tb_Option_") Or _
                        InStr(.Name, "TextBox")) Then
                     Call .Delete
                 End If
            End With
        Next
            
        For lngIndex = 2 To 20
            
          With .Worksheets("Sheet1").OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
               DisplayAsIcon:=False, Left:=147, Top:=198, Width:=30, Height:=21)
                .Enabled = False
                .Object.BackColor = RGB(190, 190, 190)
                .Left = 317.25
                .Top = lngTop + (lngIndex - 2) * 22.5
          End With
          With .Worksheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
               DisplayAsIcon:=False, Left:=147, Top:=198, Width:=30, Height:=21)
                .Object.Caption = "Aktuelle Revision"
                .Object.Value = True
                .Width = Len(.Object.Caption) * 6
                .Left = 394
                .Top = lngTop + (lngIndex - 2) * 22.5
          End With
          
        Next
    End With
    
    Call Application.OnTime(EarliestTime:=Now, Procedure:="prcRenameBoxes")
    
    End Sub
    
    Private Sub prcRenameBoxes()
    Dim objOLEObject As OLEObject
    Dim lngChkCount As Long, lngTxtCount As Long
    For Each objOLEObject In ThisWorkbook.Worksheets("Sheet1").OLEObjects
        With objOLEObject
            If .progID = "Forms.CheckBox.1" Then
              lngChkCount = lngChkCount + 1
              .Name = "cb_Option_new_" & lngChkCount
            ElseIf .progID = "Forms.TextBox.1" Then
              lngTxtCount = lngTxtCount + 1
              .Name = "tb_Option_rev_" & lngTxtCount
            End If
        End With
    Next
    End Sub




    VBA/HTML - CodeConverter für Office-Foren
    AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
    Projektbetreuung durch mumpel



    Code erstellt und getestet in Office 14

    Gruß, Mullit


      

    Betrifft: AW: Workbook_open Makro wird nicht richtig ausgeführt von: Dominik
    Geschrieben am: 16.08.2016 09:36:09

    Hallo Mullit,

    ich hatte die Vermutung, dass das Löschen und neu erzeugen Excel zu schnell geht und er deshalb denkt der Name sei bereits vergeben. Nachdem ich das Löschen in ein Before_Close-Event ausgelagert hatte, stellte sich jedoch nur bedingt Besserung ein.

    Deine Lösung hingegen funktioniert super! Vielen Dank!

    Mfg


    Beiträge aus den Excel-Beispielen zum Thema "Workbook_open Makro wird nicht richtig ausgeführt"