Formació autodidàctica en mòduls d'Enginyeria lingüística aplicada a la Traducció

Macro Llistadora

Aquesta macro converteix un document en una llista ordenada de paraules. Li pot servir a un traductor per avaluar superficialment l'impacte en un text original de determinades paraules segons la seva freqüència.




Sub Text2list()
'
' Macro text2list
'
' Macro enregistrada per Lluís de Yzaguirre i Maura
' Institut de Lingüística Aplicada
' Universitat "Pompeu Fabra"
'
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    
    substitueix " ", "^p"       ' canviem espai per retorn
    substitueix "'", "^p"       ' canviem apòstrof per retorn
    substitueix "/", "^p"       ' canviem / per retorn
    substitueix "^m", "^p"      ' canviem pàgina forçada per retorn
    substitueix "^p^p^p", "^p"  ' canviem dos retorns per un
    substitueix "^p^p", "^p"    ' canviem dos retorns per un
    substitueix ".^p", "^p"     ' simplifiquem punt+retorn
    substitueix ",^p", "^p"     ' simplifiquem coma+retorn
    substitueix "-^p", "^p"     ' simplifiquem guió+retorn
    substitueix ")^p", "^p"     ' simplifiquem
    substitueix ":^p", "^p"     ' simplifiquem
    substitueix Chr(34) + "^p", "^p"   ' simplifiquem
    substitueix "^p" + Chr(34), "^p"   ' simplifiquem
    substitueix "^p(", "^p"     ' simplifiquem
    substitueix "^p ", "^p"     ' simplifiquem
    substitueix "^p-", "^p"     ' simplifiquem
    
'  convertim a minúscules

    Selection.WholeStory
    Selection.Range.Case = wdLowerCase

'  tot seguit, ordenem la llista
    
    Selection.Sort ExcludeHeader:=False, FieldNumber:="Campo 1", SortFieldType _
        :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, FieldNumber2 _
        :="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
        wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
        wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
        wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
        :=wdLanguageNone
         
Retorn2sí1no
Elimina_Mots

    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
    Selection.MoveRight Unit:=wdCell
    Selection.SelectColumn
    Selection.Sort ExcludeHeader:=False, FieldNumber:="Columna 2", _
        SortFieldType:=wdSortFieldNumeric, SortOrder:=wdSortOrderDescending, _
        FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
        wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
        wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
        wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
        :=wdLanguageNone
    Selection.MoveLeft Unit:=wdCharacter, Count:=1


End Sub

Sub Elimina_Mots()
'
' Elimina_Mots_Repetits Macro
' Macro enregistrada per Lluís de Yzaguirre i Maura
' Institut de Lingüística Aplicada
' Universitat "Pompeu Fabra"

'

Const max = 2000
Dim mots(max) As String
Dim freq(max) As Integer
Dim m$, n$
Dim f, j As Integer

substitueix "^p", " "    ' canvia retorn per espai

For f = 1 To max
    mots(f) = " "
    freq(f) = 0
Next f
noHemAcabat = True
f = 1
j = 0
n$ = ActiveDocument.Words.First
ActiveDocument.Words.First.Delete
Do While (noHemAcabat = True)
    m$ = ActiveDocument.Words(1)
    If (m$ = n$) Then
        f = f + 1
    Else
        If (j > max - 1) Then
            MsgBox ("Només " + Str(max) + " formes!")
        Else
            j = j + 1
            mots(j) = n$
            freq(j) = f
            f = 1
        End If
    End If
    n$ = m$
    ActiveDocument.Words(1).Delete
    If ActiveDocument.Words.Count < 2 Then
        noHemAcabat = False
    End If
Loop
' resolem el darrer
    If (j > max - 1) Then
            MsgBox ("Només " + Str(max) + " formes!")
    Else
        j = j + 1
        mots(j) = n$
        freq(j) = f
    End If

For f = 1 To j
     Selection.TypeText Text:=mots(f) + Chr(9) + Str(freq(f)) + Chr(13)
Next f
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _
        NumRows:=j, Format:=wdTableFormatNone, ApplyBorders:=True, ApplyShading _
        :=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _
        ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
        AutoFit:=False

End Sub

NB aquesta macro també crida les subrutines retorn2sí1no i substitueix, que ja hem trobat.

Si us heu deixat de copiar la macro substitueix (vid supra), us sortirà aquest error, i si la teniu dos cops, aquest altre.

Per qualsevol problema amb aquesta pàgina, contacteu "de_yza@upf.es"