Macro voor alle tabbladen maken.

[Fransenloes]

Hallo allemaal,

Ik heb een macro, die zoekt in een textbox op de active sheet.

Nu zou ik graag willen, dat hij alle sheets in het werkboek doorzoekt.

Alvast bedankt!

Sub FindInShape1()
    Dim rStart As Range
    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    
    For Each shp In ActiveSheet.Shapes
        sTemp = shp.TextFrame.Characters.Text
        If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then
            shp.Select
            Response = MsgBox( _
              prompt:=shp.Name & vbCrLf & _
              sTemp & vbCrLf & vbCrLf & _
              "Do you want to continue?", _
              Buttons:=vbYesNo, Title:="Continue?")
            If Response <> vbYes Then
                Set rStart = Nothing
                Exit Sub
            End If
        End If
    Next
    MsgBox "No more found"
    
End Sub

 

[edmoor]

Probeer het eens zo:

Sub FindInShape1()
    Dim rStart As Range
    Dim shp As Shape
    Dim sh As Worksheet
    Dim sFind As String
    Dim sTemp As String
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    
    For Each sh In ThisWorkbook.Sheets
        For Each shp In sh.Shapes
            sTemp = shp.TextFrame.Characters.Text
            If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then
                shp.Select
                Response = MsgBox( _
                  prompt:=shp.Name & vbCrLf & _
                  sTemp & vbCrLf & vbCrLf & _
                  "Do you want to continue?", _
                  Buttons:=vbYesNo, Title:="Continue?")
                If Response <> vbYes Then
                    Set rStart = Nothing
                    Exit Sub
                End If
            End If
        Next
    Next sh
    MsgBox "No more found"
End Sub

 

[Fransenloes]

Jeetje, zo snel

Heel erg bedankt voor je hulp.

Frans

 

[snb]

Wat voor tekstvakken zijn het ?

Sub FindInShape1()
    c00 = InputBox("Search for?")
    If Trim(c00) = "" Then c01 = "Nothing entered"
    
    If c01 = "" Then
      c01 = "No more found"
      For Each sh In ThisWorkbook.Sheets
        For Each it In sh.Shapes
            c02 = it.TextFrame.Characters.Text
            If InStr(LCase(c02), LCase(c00)) Then
                If MsgBox(it.Parent.Name & vbLf & it.Name & vbLf & c02 & vbLf & "Do you want to continue?", 4, it.Name) = 7 Then Exit Sub
            End If
        Next
      Next
    End If

    MsgBox c01
End Sub

 

[Fransenloes]

Het zijn tekstvakken die ik bij excel normaal invoeg.

Ik krijg een foutmelding bij regel For Each it In Shapes

Ik heb meerder bladen met een andere naam, die allemaal een tekstvak bevatten.

Ik heb gezien , dat elk tekstvak een andere naam heeft (tekstvak1, 2 etc)

Misschien ligt het daaraan.

Alvast bedankt,

Frans

 

[snb]

Maak er sh.Shapes van.

 

[Fransenloes]

Sorry dat ik zo laat reageer, maar ik moest even de economie draaiende houden :d

Ik heb er shape van gemaakt, maar dit mocht niet baten.

Ik krijg een fout bij c02 = it.TextFrame.Characters.Text

Frans.

 

[edmoor]

Als je zegt een foutmelding te krijgen is het wel zo handig deze er ook bij te vermelden.

 

[HSV]

Plaats een bestand, dan wordt het vanzelf duidelijk.

 

[Fransenloes]

Hallo,

Het lukte niet met het originele werkboek, ik wilde een "uitgekleed" werkboek op dit forum uploaden en toen werkte de macro wel ( deze is dus goed!! )

Ik heb de indeling van mijn originele werkboek veranderd en kan nu gewoon zoeken met de zoekfunctie in excel.

Dus het is nu ook opgelost.

Iedereen bedankt voor het meedenken.:thumb: