DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Bunu kullanabilirsiniz...VeriSign' Alıntı:Son Birşey...Menulerin ID nolarını nereden edinebilirim ? Sizde varsa verebilirmisiniz Listesini ?
Soruma cevabı buldum..İlgilenenler için adres
http://support.microsoft.com/default.aspx?scid=kb;[LN];Q213552
Sub CommandBarControls()
'Raider ®
Dim Start As Long, Finnish As Long, ElapsedTime As Long
Dim i As Integer, j As Integer, No As Integer
Dim CtrlID As Long
Dim MySh As Worksheet, IndexSh As Worksheet
Start = Timer
On Error Resume Next
Set MySh = Worksheets.Add
MySh.Name = "CommandBars"
For k = 1 To Application.CommandBars.Count
MySh.Cells(k, 1) = Application.CommandBars(k).Name
Next k
For i = 1 To Application.CommandBars.Count
Set MySh = Worksheets.Add
Set MyCmdBar = Application.CommandBars(i)
No = No + 1
MySh.Name = MyCmdBar.Name
With MySh
.Range("B1") = UCase(MySh.Name)
.Range("A2") = "Etiket"
.Range("B2") = "Control ID"
.Range("C2") = "Face"
.Range("D2") = "CommandBars sayfasına dönüş !"
.Range("A1:D2").Font.Bold = True
.Range("A1:C2").Font.Color = vbRed
.Range("A1:C2").Font.Size = 12
.Range("B1").Font.Color = vbBlack
.Hyperlinks.Add Anchor:=.Range("D2"), Address:="", _
SubAddress:="'CommandBars'!A1"
End With
For j = 3 To MyCmdBar.Controls.Count
MySh.Cells(j, 1) = MyCmdBar.Controls(j).Caption
CtrlID = MyCmdBar.Controls(j).ID
MySh.Cells(j, 2) = CtrlID
Set MyControl = MyCmdBar.FindControl(Type:=msoControlButton, ID:=CtrlID)
MyControl.CopyFace
MySh.Paste Destination:=MySh.Cells(j, 3)
MySh.Columns("A:D").AutoFit
Next j
Next i
Set IndexSh = Worksheets("CommandBars")
For i = 1 To IndexSh.Cells(65536, 1).End(xlUp).Row
ActiveSheet.Hyperlinks.Add Anchor:=IndexSh.Cells(i, 1), _
Address:="", SubAddress:="'" & IndexSh.Cells(i, 1).Text & "'!A1", _
TextToDisplay:=IndexSh.Cells(i, 1).Text
Next i
IndexSh.Activate
IndexSh.Columns("A:A").AutoFit
Finnish = Timer
ElapsedTime = Finnish - Start
MsgBox "Excel'in menülerindeki ve araç çubuklarındaki kontroller " _
& vbCrLf & Int(ElapsedTime) & " saniyede sayfalara işlenmiştir !" _
& vbCrLf & vbCrLf _
& "Bu iş için toplam : " & No + 1 & " adet sayfa, " _
& "bu XL dosyasına ilave edilmiştir.", vbInformation, "Rapor !"
Set IndexSh = Nothing
Set MyControl = Nothing
Set MyCmdBar = Nothing
Set MySh = Nothing
End Sub