ListBox - ActiveX - platzieren auf allen Tabellenblättern - bei Sheet_Activate...

Frage: Eine ActiveX Listbox soll auf allen Tabellenblättern platziert werden. Dies soll beim aktivieren des Tabellenblattes ausgeführt werden. Es sind noch andere ActiveX und Formelemente auf den jeweiligen Tabellenblättern. Im Beispiel wird die Listbox an der Zelle J3 ausgerichtet (Höhe 100, Breite 200). Die Type-Optionen können je nach Bedarf angepasst werden.

An ActiveX list box will be placed on all worksheets. This should be executed when activating the worksheet. There are other ActiveX and form elements on the respective worksheets. In the example, the list box will be aligned with the cell J3 (height 100, width 200). The Type options can be adjusted as needed.

Hier noch eine Beispieldatei / Here's a sample file:
ListBox - ActiveX - platzieren auf allen Tabellenblättern - bei Sheet_Activate...[XLS 70 KB]

Option Explicit
'--------------------------------------------------------------------------
' Module    : ThisWorkbook
' Procedure : Workbook_SheetActivate
' Author    : Case (Ralf Stolzenburg)
' Date      : 09.04.2013
' Purpose   : Listbox place in all worksheets...
'--------------------------------------------------------------------------
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim shpShape As Shape
    Dim lngCalc As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
    With Application
        ' Das Bildschirmaktualisierung wird unterbrochen
        .ScreenUpdating = False
        ' Ereignisroutinen werden deaktiviert
        .EnableEvents = False
        ' Auslesen der momentanen Einstellung für die Berechnung
        lngCalc = .Calculation
        ' Setzen der Berechnung auf "Manuell"
        .Calculation = xlCalculationManual
        '  Eingabeaufforderungen und Warnmeldungen unterdrücken
        .DisplayAlerts = False
    End With
    ' Schleife über alle Shapes
    For Each shpShape In Sh.Shapes
        ' Wenn das Shape kein FormControl ist, dann...
        If shpShape.Type <> msoFormControl Then
            ' Wenn es keine Textfeld ist, dann...
            If Not shpShape.Type = msoTextBox Then
                ' Wenn es eine ListBox ist, dann...
                If shpShape.DrawingObject.progID = "Forms.ListBox.1" Then
                    ' Platzieren mit Höhe und Breite
                    With shpShape
                        .Top = Range("J3").Top
                        .Left = Range("J3").Left
                        .Width = 200
                        .Height = 100
                    End With
                End If
            End If
        End If
    Next shpShape
Fin:
    ' Die Applikation aufwecken
    With Application
        ' Bildschirmaktualisierung wieder einschalten
        .ScreenUpdating = True
        ' Ereignisroutinen werden wieder aktiviert
        .EnableEvents = True
        ' Setzen der Berechnung auf den gemerkten Wert
        .Calculation = lngCalc
        ' Eingabeaufforderungen und Warnmeldungen wieder zulassen
        .DisplayAlerts = True
        ' Abbrechen Ausschneide- bzw. Kopiermodus und entfernen des Laufrahmens
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...