Butona Arama görevi verme

[kitreli]

Arkadaşlar; ben ekteki dosyamda yapmak istediğim Anasayfamda bulunan arama butonuna tıkladığım zaman kart siparişi sayfamdan(herhangi bir done) arama yapmak..!

CTRL+F kombinasyonunun atamasıda olabilir...

 

[N.Ziya Hiçdurmaz]

yanıt

Dosyanız ekte inceleyiniz.

Sub FindItAll()
    Dim oSheet As Object
    Dim Firstcell As Range
    Dim NextCell As Range
    Dim WhatToFind As Variant
    WhatToFind = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
        If WhatToFind <> "" And Not WhatToFind = False Then
            For Each oSheet In ActiveWorkbook.Worksheets
            oSheet.Activate
            oSheet.[a1].Activate
            Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                If Not Firstcell Is Nothing Then
                Firstcell.Activate
                MsgBox ("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & Firstcell.Address)
                On Error Resume Next
                    While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
                    Set NextCell = Cells.FindNext(After:=ActiveCell)
                        If Not NextCell.Address = Firstcell.Address Then
                        NextCell.Activate
                        MsgBox ("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & NextCell.Address)
                        End If
                    Wend
                End If
            Set NextCell = Nothing
            Set Firstcell = Nothing
            Next oSheet
        End If
End Sub

 

[kitreli]

Yardımınız için teşekkür ederim..
Ancak bunda bi sorun var.
arama yaptıktan sonra yazdığım doneyi buluyor benim istediğim o cümleyse ben aramaya devam etmek istemiyorum. ama aynı aranan dan daha varsa arama ekranını kapatamıyorum..


BU MACRO CTRL+F KOMBİNASYONUNDAKİ GİBİ OLABİLİRMİ?

 

[kitreli]

Arkadaşlar yukarıda ki isteğimle ilgili yardım istemiştim. Ama şu ana kadar bakan olmadı..

 

[veyselemre]

Sub FindItAll()
Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
    On Error Resume Next
    WhatToFind = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
    If WhatToFind <> "" And Not WhatToFind = False Then
        For Each oSheet In ActiveWorkbook.Worksheets
            oSheet.Activate
            oSheet.[a1].Activate
            Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
                                                                           :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If Not Firstcell Is Nothing Then
                Firstcell.Activate
                If MsgBox("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & Firstcell.Address & vbCr & vbCr & "Aramaya Devam Etmek &#304;stiyor musunuz?", vbYesNo) = vbNo Then End
                
                While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
                    Set NextCell = Cells.FindNext(After:=ActiveCell)
                    If Not NextCell.Address = Firstcell.Address Then
                        NextCell.Activate
                   If MsgBox("Found " & Chr(34) & WhatToFind & Chr(34) & " in " & oSheet.Name & "!" & NextCell.Address & vbCr & vbCr & "Aramaya Devam Etmek &#304;stiyor musunuz?", vbYesNo) = vbNo Then End
                    End If
                Wend
            End If
            Set NextCell = Nothing
            Set Firstcell = Nothing
        Next oSheet
    End If
End Sub

 

[kitreli]

Teşekkür ederim Veyselemre...