AW: Commandbar-Controls
19.10.2005 19:58:05
Heiko
Hallo Stefan,
vielleicht hift dir das weiter. Erstes Makro für Tabelle1 zweites für Tabelle2. Tabellen sollten leer sein. Hab ich hier auch mal im Forum gefunden.
Sub IDFinder()
Dim oBar As CommandBar
Dim oCtr As CommandBarControl
Dim oBtn As CommandBarButton
Dim iRow As Integer
Range("A1").Value = "Symbolleiste"
Range("B1").Value = "Lokaler Name"
Range("C1").Value = "Sichtbar"
Range("D1").Value = "Schaltfläche"
Range("E1").Value = "ID"
Range("A1:E1").Font.Bold = True
iRow = 1
For Each oBar In CommandBars
If oBar.BuiltIn Then
iRow = iRow + 1
Cells(iRow, 1) = oBar.Name
Cells(iRow, 2) = oBar.NameLocal
Cells(iRow, 3) = oBar.Visible
For Each oCtr In oBar.Controls
If oCtr.BuiltIn Then
Cells(iRow, 4) = oCtr.Caption
Cells(iRow, 5) = oCtr.ID
Cells(iRow, 6) = oCtr.Index
CommandBars(oBar.Name).Controls(oCtr.Index).CopyFace
iRow = iRow + 1
End If
Next oCtr
End If
Next oBar
Columns.AutoFit
End Sub
Sub SymboleInTabelle()
Dim inti As Integer, intt As Integer
Application.ScreenUpdating = False
Worksheets("Tabelle2").Range("A1").Select
On Error Resume Next
For intt = 1 To CommandBars.Count
For inti = 1 To CommandBars(intt).Controls.Count
CommandBars(intt).Controls(inti).CopyFace
If Err.Number = 0 Then
ActiveSheet.Paste
End If
Err.Clear
ActiveCell.Offset(0, 2).Value = CommandBars(intt).Controls(inti).Caption
ActiveCell.Offset(0, 3).Value = CommandBars(intt).Controls(inti).ID
ActiveCell.Offset(1, 0).Select
Next inti
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "Das war die Symbolleiste: " & CommandBars(intt).Name
ActiveCell.Offset(2, 0).Select
Next intt
Application.ScreenUpdating = True
Worksheets("Tabelle2").Columns("A:A").AutoFit
End Sub
Gruß Heiko
PS: Rückmeldung wäre nett