Visual Basic para Aplicaciones - buscar y ejecutar una macro

Sub Alonso()

'

' Alonso Macro

' Macro grabada el 26/06/03 por Alberto Bastián Ordiales

'

    Selection.TypeText Text:=vbTab

    Selection.Font.Bold = wdToggle

    Selection.Font.Size = 9

    Selection.TypeText Text:="LA SEÑORA ROMERO ALONSO "

    Selection.Font.Size = 10

    Selection.TypeText Text:="(consejera de Participación, Cooperación y Derechos Humanos):"

    Selection.Font.Bold = wdToggle

    Selection.TypeText Text:=" "

End Sub

Antonio vive en 1*

Antonio vive en Sub Alonso()

    '

    ' Alonso Macro

    ' Macro grabada el 26/06/03 por Alberto Bastián Ordiales

    '

    Selection.TypeText Text:=vbTab

    Selection.Font.Bold = wdToggle

    Selection.Font.Size = 9

    Selection.TypeText Text:="LA SEÑORA ROMERO ALONSO "

    Selection.Font.Size = 10

    Selection.TypeText Text:="(consejera de Participación, Cooperación y Derechos Humanos):"

    Selection.Font.Bold = wdToggle

    Selection.TypeText Text:=" "

End Sub

Sub Macro3()

    CommandBars("Navigation").Visible = False

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "1*"

        .Replacement.Text = "1*"

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    On Error GoTo Fin

    While True

        With Selection

            If .Find.Forward = True Then

                .Collapse Direction:=wdCollapseStart

            Else

                .Collapse Direction:=wdCollapseEnd

            End If

            .Find.Execute Replace:=wdReplaceOne

            If .Find.Forward = True Then

                .Collapse Direction:=wdCollapseEnd

            Else

                .Collapse Direction:=wdCollapseStart

            End If

            .Find.Execute

        End With

        Call Alonso

    Wend

Fin:

End Sub

Sub Alonso()

    '

    ' Alonso Macro

    ' Macro grabada el 26/06/03 por Alberto Bastián Ordiales

    '

    Selection.TypeText Text:=vbTab

    Selection.Font.Bold = wdToggle

    Selection.Font.Size = 9

    Selection.TypeText Text:="LA SEÑORA ROMERO ALONSO "

    Selection.Font.Size = 10

    Selection.TypeText Text:="(consejera de Participación, Cooperación y Derechos Humanos):"

    Selection.Font.Bold = wdToggle

    Selection.TypeText Text:=" "

End Sub

Sub FindWords()

    Dim sResponse As String

    Dim iCount As Integer

    ' Input different words until the user clicks cancel

    Do

        ' Identify the word to count

        sResponse = InputBox( _

          Prompt:="¿Qué palabra quieres contar?", _

          Title:="Contar palabras", Default:="")

        If sResponse > "" Then

            ' Set the counter to zero for each loop

            iCount = 0

            Application.ScreenUpdating = False

            With Selection

                .HomeKey Unit:=wdStory

                With .Find

                    .ClearFormatting

                    .Text = sResponse

                    ' Loop until Word can no longer

                    ' find the search string and

                    ' count each instance

                    Do While .Execute

                        iCount = iCount + 1

                        Selection.MoveRight

                    Loop

                End With

                ' show the number of occurences

                MsgBox sResponse & " appears " & iCount & " times"

            End With

            Application.ScreenUpdating = True

        End If

    Loop While sResponse <> ""

End Sub

Sub AAAWordFrequency()

    Const maxwords = 9000          'Maximum unique words allowed

    Dim SingleWord As String       'Raw word pulled from doc

    Dim Words(maxwords) As String  'Array to hold unique words

    Dim Freq(maxwords) As Integer  'Frequency counter for unique words

    Dim WordNum As Integer         'Number of unique words

    Dim ByFreq As Boolean          'Flag for sorting order

    Dim ttlwds As Long             'Total words in the document

    Dim Excludes As String         'Words to be excluded

    Dim Found As Boolean           'Temporary flag

    Dim j, k, l, Temp As Integer   'Temporary variables

    Dim ans As String              'How user wants to sort results

    Dim tword As String            '

    Dim aword As Object            '

    Dim tmpName As String          '

    ' Set up excluded words

    Excludes = "[the][a][of][is][to][for][by][be][and][are]"

    ' Find out how to sort

    ByFreq = True

    ans = InputBox("Sort by WORD or by FREQ?", "Sort order", "WORD")

    If ans = "" Then End

    If UCase(ans) = "WORD" Then

        ByFreq = False

    End If

    Selection.HomeKey Unit:=wdStory

    System.Cursor = wdCursorWait

    WordNum = 0

    ttlwds = ActiveDocument.Words.Count

    ' Control the repeat

    For Each aword In ActiveDocument.Words

        SingleWord = Trim(LCase(aword))

        'Out of range?

        If SingleWord < "a" Or SingleWord > "z" Then

            SingleWord = ""

        End If

        'On exclude list?

        If InStr(Excludes, "[" & SingleWord & "]") Then

            SingleWord = ""

        End If

        If Len(SingleWord) > 0 Then

            Found = False

            For j = 1 To WordNum

                If Words(j) = SingleWord Then

                    Freq(j) = Freq(j) + 1

                    Found = True

                    Exit For

                End If

            Next j

            If Not Found Then

                WordNum = WordNum + 1

                Words(WordNum) = SingleWord

                Freq(WordNum) = 1

            End If

            If WordNum > maxwords - 1 Then

                j = MsgBox("Too many words.", vbOKOnly)

                Exit For

            End If

        End If

        ttlwds = ttlwds - 1

        StatusBar = "Remaining: " & ttlwds & ", Unique: " & WordNum

    Next aword

    ' Now sort it into word order

    For j = 1 To WordNum - 1

        k = j

        For l = j + 1 To WordNum

            If (Not ByFreq And Words(l) < Words(k)) _

              Or (ByFreq And Freq(l) > Freq(k)) Then k = l

        Next l

        If k <> j Then

            tword = Words(j)

            Words(j) = Words(k)

            Words(k) = tword

            Temp = Freq(j)

            Freq(j) = Freq(k)

            Freq(k) = Temp

        End If

        StatusBar = "Sorting: " & WordNum - j

    Next j

    ' Now write out the results

    tmpName = ActiveDocument.AttachedTemplate.FullName

    Documents.Add Template:=tmpName, NewTemplate:=False

    Selection.ParagraphFormat.TabStops.ClearAll

    With Selection

        For j = 1 To WordNum

            .TypeText Text:=Trim(Str(Freq(j))) _

              & vbTab & Words(j) & vbCrLf

        Next j

    End With

    System.Cursor = wdCursorNormal

    j = MsgBox("There were " & Trim(Str(WordNum)) & _

      " different words ", vbOKOnly, "Finished")

End Sub