ctrl+f komutunu butona bağlamak?

[hurkanpisirici]

merhaba bunu bir kodla yapabilirmiyiz acaba?

 

[Haluk]

Sub Test()
    Application.CommandBars.FindControl(ID:=1849).Execute
End Sub

 

[Leoncio]

Merhaba;
Aşağıdaki kodları deneyiniz.

Sub bul()

Application.Dialogs(xlDialogFormulaFind).Show
End Sub

 

[hurkanpisirici]

arkadaşlar çok teşekkür edeirm sağolun.
sayın haluk bey sitede ıd noları ile ilgili bir çalışma vardı ama şimdi bulamadım siz hatırlıyrmusunuz öyle bir çalışma?

 

[Haluk]

Bu olabilir belki...

    'Haluk ® - 17/02/2006
    Sub CommandBarControlID()
        Dim Header1 As String * 5
        Dim Header2 As String * 38
        Dim Header3 As String * 10
        Dim Capt As String * 30
        Dim WinScrObj As Object, MyShortCut As Object
        Dim MyFolder As String, MyFile As String
        Dim TargPath As String

        TargPath = "C:\MS-ExcelControlsID.txt"
        MyFile = "MS-ExcelControlsID.txt"
       
        Header1 = "No"
        Header2 = "Kontrol"
        Header3 = "ID"
            Open TargPath For Output As #1
            Print #1, Header1; Header2; Header3
            Print #1, String(50, "-")
            Print #1,
                For Each Ctrl In CommandBars.FindControls
                    i = i + 1
                    Capt = Replace(Ctrl.Caption, "&", "")
                    CtrlId = Ctrl.ID
                    Print #1, i & ") "; Capt, CtrlId
                Next
            Close #1
           
        Set WinScrObj = CreateObject("WScript.Shell")
        MyFolder = WinScrObj.SpecialFolders("DeskTop")
        Set MyShortCut = WinScrObj.CreateShortcut _
                        (MyFolder & "\" & MyFile & ".lnk")
        With MyShortCut
            .TargetPath = WinScrObj.ExpandEnvironmentStrings(TargPath)
            .WorkingDirectory = WinScrObj.ExpandEnvironmentStrings(TargPath)
            .WindowStyle = 4
            .IconLocation = WinScrObj.ExpandEnvironmentStrings(TargPath & ", 0")
            .Save
        End With
       
        MsgBox "Masaustune dosya icin kisa yol olusturuldu ...", vbInformation, "Rapor !"
        Set WinScrObj = Nothing
        Set MyShortCut = Nothing
    End Sub

Veya bu;

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

 

[hurkanpisirici]

bunu anlamadım benim dediğim liste halinde ID=NUMARA şeklinde bir liste idi yinede sağolun.

 

[kykbt]

Haluk Hocam eline aklına sağlık.

Ne yapmışsın böyle

Teşekkürler

 

[peleryn]

Sub bul()
Application.Dialogs(xlDialogFormulaFind).Show
End Sub

makrosu "Bul" modülünü açıyor."Bul ve Değiştir" modülünü açmak için ne yazmak gerekir?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub DEĞİŞTİR()
    Application.Dialogs(xlDialogFormulaReplace).Show
End Sub

 

[peleryn]

Korhan hocam teşekkür ederim.Bu kodla da değiştir modülü açılıyor.Ama bir de bul ve değiştir'in bir arada olduğu bir modül var onu nasıl açabiliriz.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Sub BUL_DEĞİŞTİR()
    Application.SendKeys ("^h")
End Sub

 

[halit3]

Korhan hocam teşekkür ederim.Bu kodla da değiştir modülü açılıyor.Ama bir de bul ve değiştir'in bir arada olduğu bir modül var onu nasıl açabiliriz.

alternatif kod

Sub buldeğiştir()
On Error Resume Next
Application.Dialogs(64).Show
End Sub

 

[halit3]

Korhan hocam teşekkür ederim.Bu kodla da değiştir modülü açılıyor.Ama bir de bul ve değiştir'in bir arada olduğu bir modül var onu nasıl açabiliriz.

alternatif kod

  Sub buldeğiştir()
On Error Resume Next
Application.Dialogs(64).Show
End Sub

 

[izcik]

Aynısı mıdır bilmiyorum ama iki adet güzel dosya

 

[peleryn]

Sayın izcik;

Ctrl+F Makrosu.xls adıyla paylaştığınız dosya istediğim dosya çok teşekkür ederim.

Korhan Bey kodunuzu neden olduğunu anlamadım ama çalıştıramadım.

halit3 hocam size de ilginiz için teşekkür ederim.

Merak eden olursa diye kodu ekliyorum.

Option Explicit

Sub BUL()
Application.SendKeys ("^f")
End Sub

 

[izcik]

Rica ederim değerli peleryn