• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Alt+F11 Tuş İptali

Sayın VeriSign userform üzerine bir label ekleyin. ve aşağıdaki kodları ekleyin.
[vb:1:dc63ae0b7c]Private Sub UserForm_Activate()
Do
Label1.Caption = Format(Now, "dd.mm.yyyy - hh:mm:ss")
DoEvents
Loop
End Sub[/vb:1:dc63ae0b7c]
Bir ara böyle bir olayı keşfetmiştim. Fakat Araçlar->Makro->VBA düzenleyicisinde formun çalışmasını durdurarak Alt+F11 geçerli oluyor.
 
Ekli dosyayı bir ara inceleyin .... eskiden yaptığım bir çalışmaydı. İşinize yarayan kısımları olucak içinde.

Not: Resimdeki menüyü tıklayınca gelen şifre penceresinde yazılacak şifre : raider
 
Dosyayı inceledigimde bahsettiginiz secenegi tıkladıgımda " Visualbasic Projesine Programlı Olarak erişim Güvenli Degil" adlı bir mesaj vermektedir.
 
Office ayarlarında güvenliği ayarlamanız gerekiyor.

"VBA projelerine erişime güven..." gibi bir seçenek olması lazım.
 
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
Genişletmek için tıkla ...

Bunu kullanabilirsiniz...

Kod: 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst