Macro en Word para contar palabras

En este post te voy a compartir el código que necesitas utilizar si quieres contar cuántas veces se repite cada palabra en tu texto de Word , para ello vamos a crear una Macro en WORD.

Lo primero que tenemos que hacer es configurar nuestra barra de trabajo

Seleccionan el Menu File>Options>Customize Ribbon o en Español Archivo>Opciones>barra de tareas

Despues la parte de seguridad de las macros
Menu File>Options>Trus Center o Archivo>Opciones>Centro de Seguridad y marcamos como se ve en la imagen, la cuarta opción y el combo

Después vamos a seleccionar en la barra de desarrollador e, botón que dice Macro

Y nos va a salir una pantalla para ponerle un nombre a nuestra macro y vamos  a seleccionar el botón de Create o Crear

Nos va abrir la pantalla de VB para editar nuestro código

Luego vamos a utilizar el siguiente código, 

Sub Contar_palabras()

'

' Contar_palabras Macro

'

'

                    Const maxwords = 10000          'Vamos a poner un limite para las palabras a contrar

                    Dim SingleWord As String       'vamos a tener esta variable para ir guardando las palabras

                    Dim Words(maxwords) As String  'Aqui vamos ir almacenando las palabras

                    Dim Freq(maxwords) As Integer  'Aqui vamos almacenar cada cuanto se repiten las palabras

                    Dim WordNum As Integer         'numero para ir contando cada palabra

                    Dim ByFreq As Boolean          'una banderita para ordenar por frecuencia

                    Dim ttlwds As Long             'contador de numero total de palabras

                    Dim Found As Boolean           'Temporary flag

                    Dim j, k, l, Temp As Integer   'varibales para navegar entre los arreglos

                    Dim ans As String              'modo de ordenacmiento si por palabras o si por frecuencia

                    Dim tword As String

                    ' Esta es una pantalla para preguntar como quiere el usuario ordenar las palabras

                    ByFreq = True

                    ans = InputBox("Como quieres ordener el resultado por  PALABRA o por FRECUENCIA?", "Sort order", "PALABRA")

                    If ans = "" Then End

                    If UCase(ans) = "PALABRA" Then

                        ByFreq = False

                    End If

                    

                    Selection.HomeKey Unit:=wdStory

                    System.Cursor = wdCursorWait

                    WordNum = 0

                    ttlwds = ActiveDocument.Words.Count

                    ' Nuestro For each de busqueda

                    For Each aword In ActiveDocument.Words

                        SingleWord = Trim(LCase(aword))

                        'Out of range?

                        If SingleWord < "a" Or SingleWord > "z" 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("Lo maximo permitido son 9000", vbOKOnly)

                                Exit For

                            End If

                        End If

                        ttlwds = ttlwds - 1

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

                    Next aword

                    ' Ahora si a ordenar los datos

                   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 = "Ordenando: " & WordNum - j

                    Next j

    ' Escribimos los resultados en nuevo archivo de WORD

                    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("Se encontraron " & Trim(Str(WordNum)) & _

                      " Palabras Diferentes ", vbOKOnly, "Finished")

             

                        

End Sub

Así debe quedar en la pantalla

Ahora vamos a ejecutarla

Nos va a preguntar como queremos ordenar los datos

Como resultado vamos a ver un nuevo archivo de word con cada palabra y cada cuanto se repite

Espero les sea de utilidad y nos compartan