Languages

[Mike Faulkner]

Hello
Windows XP
Office 2002/3

I'm looking for some VBA code which will loop through the active document
returning the number of different languages used within it.

Any suggestions will be appreciated.

Regards
Mike

 

[karitaat]

Mike,

something like this.
I loop through each Word in the document. Technically this is not
correct: each Character can have a LanguageID; but you'll get the
point.

It might be wise to let your user know what Word is doing, otherwise
they might think Word hangs.

Hope this helps.

Regards,
peter


Sub GetUniqueLangs()

Dim UniqueLangs() As Long 'contains the unique
languageIDs
Dim CurLang As Long 'Current language
Dim PrevLang As Long 'Previous language
Dim aWord As Range 'a word
Dim i As Integer 'simple counter

ReDim UniqueLangs(1 To 1)
PrevLang = ActiveDocument.Words(1).LanguageID
UniqueLangs(1) = PrevLang

With ActiveDocument
For Each aWord In .Words
CurLang = aWord.LanguageID
If PrevLang <> CurLang Then
AddLang CurLang, UniqueLangs
PrevLang = CurLang
End If
Next aWord
End With 'Activedocument

MsgBox Prompt:="There are " & UBound(UniqueLangs, 1) & " different
languages in Doc", _
Title:="Count Languages"

Set aWord = Nothing

End Sub 'GetUniqueLangs

Private Sub AddLang(aLang As Long, UniqueLangs() As Long)

Dim i As Integer

For i = LBound(UniqueLangs, 1) To UBound(UniqueLangs, 1)
If aLang = UniqueLangs(i) Then Exit Sub
Next i
'fallen through the bottom; i = Ubound()+1

ReDim Preserve UniqueLangs(1 To i)
UniqueLangs(i) = aLang

End Sub 'AddLang


Mike Faulkner schreef:

 

[Mike Faulkner]

Peter

Many thanks for your code. I have created something similar. When testing
each Word or each Character the code runs very slowly (get a faster PC!). We
regulary work on 300/400 page documents. I was hoping to find a fast method
to discover the number of languages 'in use' in a document.

Function CheckNumberOfLanguages()
Const cstrProcedure = "CheckNumberOfLanguages"
On Error GoTo err_CheckNumberOfLanguages
Dim lngCounter As Long
Dim lngItem As Long
Dim lngChars As Long
Dim lngLanguage As Long
Dim lngLang As Long
Dim strLang As String
Dim strLanguages As String

lngCounter = 1
lngItem = 1

With ActiveDocument
lngChars = .Words.Count

Do While lngCounter <= lngChars
lngLang = .Words(lngCounter).LanguageID
strLang = Languages(lngLang)
strLang = lngLang & " - " & strLang

If InStr(1, strLanguages, strLang, vbTextCompare) = 0 Then
strLanguages = strLanguages & lngItem & ". " & strLang & vbCr
lngItem = lngItem + 1
End If

lngCounter = lngCounter + 1

Loop

End With

'Assign Global variable with Languages found
gstrLanguages = strLanguages

'Test script
'MsgBox gstrLanguages

ExitPoint:
Exit Function

err_CheckNumberOfLanguages:
MsgBox "Error " & Err.Number & " - " & Err.Description & ", occured in " &
cstrProcedure & ".", vbInformation, gcstrMessageTitle
Resume ExitPoint

End Function

Regards
Mike

 

[Helmut Weber]

Hi Mike,

very interesting.

I think in theory, there is no fastest solution.
The crucial point in searching for different things,
when it comes to speed,
is the question, what thing to search for first?

I'd try to set up a list of languages,
with the most common first.
Search for the first language in the list,
and, if found, delete the found text.
If there is text left, then continue...

If you want to be sure, that there is no text in
Konkani
msoLanguageIDKonkani ' 1111
you have to search for Konkani,
or to search for all other languages and check,
whether there is any text left.

No way around it, IMHO.

msoLanguageIDAfrikaans 1078
msoLanguageIDAlbanian 1052
msoLanguageIDAmharic 1118
msoLanguageIDArabic 1025
msoLanguageIDArabicAlgeria 5121
msoLanguageIDArabicBahrain 15361
msoLanguageIDArabicEgypt 3073
msoLanguageIDArabicIraq 2049
msoLanguageIDArabicJordan 11265
msoLanguageIDArabicKuwait 13313
msoLanguageIDArabicLebanon 12289
msoLanguageIDArabicLibya 4097
msoLanguageIDArabicMorocco 6145
msoLanguageIDArabicOman 8193
msoLanguageIDArabicQatar 16385
msoLanguageIDArabicSyria 10241
msoLanguageIDArabicTunisia 7169
msoLanguageIDArabicUAE 14337
msoLanguageIDArabicYemen 9217
msoLanguageIDArmenian 1067
msoLanguageIDAssamese 1101
msoLanguageIDAzeriCyrillic 2092
msoLanguageIDAzeriLatin 1068
msoLanguageIDBasque 1069
msoLanguageIDBelgianDutch 2067
msoLanguageIDBelgianFrench 2060
msoLanguageIDBengali 1093
msoLanguageIDBrazilianPortuguese 1046
msoLanguageIDBulgarian 1026
msoLanguageIDBurmese 1109
msoLanguageIDByelorussian 1059
msoLanguageIDCatalan 1027
msoLanguageIDCherokee 1116
msoLanguageIDChineseHongKong 3076
msoLanguageIDChineseMacao 5124
msoLanguageIDChineseSingapore 4100
msoLanguageIDCroatian 1050
msoLanguageIDCzech 1029
msoLanguageIDDanish 1030
msoLanguageIDDutch 1043
msoLanguageIDEnglishAUS 3081
msoLanguageIDEnglishBelize 10249
msoLanguageIDEnglishCanadian 4105
msoLanguageIDEnglishCaribbean 9225
msoLanguageIDEnglishIreland 6153
msoLanguageIDEnglishJamaica 8201
msoLanguageIDEnglishNewZealand 5129
msoLanguageIDEnglishPhilippines 13321
msoLanguageIDEnglishSouthAfrica 7177
msoLanguageIDEnglishTrinidad 11273
msoLanguageIDEnglishUK 2057
msoLanguageIDEnglishUS 1033
msoLanguageIDEnglishZimbabwe 12297
msoLanguageIDEstonian 1061
msoLanguageIDFaeroese 1080
msoLanguageIDFarsi 1065
msoLanguageIDFinnish 1035
msoLanguageIDFrench 1036
msoLanguageIDFrenchCameroon 11276
msoLanguageIDFrenchCanadian 3084
msoLanguageIDFrenchCotedIvoire 12300
msoLanguageIDFrenchLuxembourg 5132
msoLanguageIDFrenchMali 13324
msoLanguageIDFrenchMonaco 6156
msoLanguageIDFrenchReunion 8204
msoLanguageIDFrenchSenegal 10252
msoLanguageIDFrenchWestIndies 7180
msoLanguageIDFrenchZaire 9228
msoLanguageIDFrisianNetherlands 1122
msoLanguageIDGaelicIreland 2108
msoLanguageIDGaelicScotland 1084
msoLanguageIDGalician 1110
msoLanguageIDGeorgian 1079
msoLanguageIDGerman 1031
msoLanguageIDGermanAustria 3079
msoLanguageIDGermanLiechtenstein 5127
msoLanguageIDGermanLuxembourg 4103
msoLanguageIDGreek 1032
msoLanguageIDGujarati 1095
msoLanguageIDHebrew 1037
msoLanguageIDHindi 1081
msoLanguageIDHungarian 1038
msoLanguageIDIcelandic 1039
msoLanguageIDIndonesian 1057
msoLanguageIDInuktitut 1117
msoLanguageIDItalian 1040
msoLanguageIDJapanese 1041
msoLanguageIDKannada 1099
msoLanguageIDKashmiri 1120
msoLanguageIDKazakh 1087
msoLanguageIDKhmer 1107
msoLanguageIDKirghiz 1088
msoLanguageIDKonkani 1111
msoLanguageIDKorean 1042
msoLanguageIDLao 1108
msoLanguageIDLatvian 1062
msoLanguageIDLithuanian 1063
msoLanguageIDMacedonian 1071
msoLanguageIDMalayalam 1100
msoLanguageIDMalayBruneiDarussalam 2110
msoLanguageIDMalaysian 1086
msoLanguageIDMaltese 1082
msoLanguageIDManipuri 1112
msoLanguageIDMarathi 1102
msoLanguageIDMexicanSpanish 2058
msoLanguageIDMixed -2
msoLanguageIDMongolian 1104
msoLanguageIDNepali 1121
msoLanguageIDNone 0
msoLanguageIDNoProofing 1024
msoLanguageIDNorwegianBokmol 1044
msoLanguageIDNorwegianNynorsk 2068
msoLanguageIDOriya 1096
msoLanguageIDOromo 1138
msoLanguageIDPolish 1045
msoLanguageIDPortuguese 2070
msoLanguageIDPunjabi 1094
msoLanguageIDRhaetoRomanic 1047
msoLanguageIDRomanian 1048
msoLanguageIDRomanianMoldova 2072
msoLanguageIDRussian 1049
msoLanguageIDRussianMoldova 2073
msoLanguageIDSamiLappish 1083
msoLanguageIDSanskrit 1103
msoLanguageIDSerbianCyrillic 3098
msoLanguageIDSerbianLatin 2074
msoLanguageIDSesotho 1072
msoLanguageIDSimplifiedChinese 2052
msoLanguageIDSindhi 1113
msoLanguageIDSlovak 1051
msoLanguageIDSlovenian 1060
msoLanguageIDSorbian 1070
msoLanguageIDSpanish 1034
msoLanguageIDSpanishArgentina 11274
msoLanguageIDSpanishBolivia 16394
msoLanguageIDSpanishChile 13322
msoLanguageIDSpanishColombia 9226
msoLanguageIDSpanishCostaRica 5130
msoLanguageIDSpanishDominicanRepublic 7178
msoLanguageIDSpanishEcuador 12298
msoLanguageIDSpanishElSalvador 17418
msoLanguageIDSpanishGuatemala 4106
msoLanguageIDSpanishHonduras 18442
msoLanguageIDSpanishModernSort 3082
msoLanguageIDSpanishNicaragua 19466
msoLanguageIDSpanishPanama 6154
msoLanguageIDSpanishParaguay 15370
msoLanguageIDSpanishPeru 10250
msoLanguageIDSpanishPuertoRico 20490
msoLanguageIDSpanishUruguay 14346
msoLanguageIDSpanishVenezuela 8202
msoLanguageIDSutu 1072
msoLanguageIDSwahili 1089
msoLanguageIDSwedish 1053
msoLanguageIDSwedishFinland 2077
msoLanguageIDSwissFrench 4108
msoLanguageIDSwissGerman 2055
msoLanguageIDSwissItalian 2064
msoLanguageIDTajik 1064
msoLanguageIDTamil 1097
msoLanguageIDTatar 1092
msoLanguageIDTelugu 1098
msoLanguageIDThai 1054
msoLanguageIDTibetan 1105
msoLanguageIDTigrignaEritrea 2163
msoLanguageIDTigrignaEthiopic 1139
msoLanguageIDTraditionalChinese 1028
msoLanguageIDTsonga 1073
msoLanguageIDTswana 1074
msoLanguageIDTurkish 1055
msoLanguageIDTurkmen 1090
msoLanguageIDUkrainian 1058
msoLanguageIDUrdu 1056
msoLanguageIDUzbekCyrillic 2115
msoLanguageIDUzbekLatin 1091
msoLanguageIDVenda 1075
msoLanguageIDVietnamese 1066
msoLanguageIDWelsh 1106
msoLanguageIDXhosa 1076
msoLanguageIDZulu 1077

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Tony Jollans]

Rather than hard coding and guessing what languages might be present or what
might be the most common language and maybe missing new languages or ones
without defined constants, what about taking the information from the
document, one language at a time as it is found. Something like this ...

Dim CurrentLanguage As Long
Dim CurrentPosition As Long
CurrentPosition = 1

Dim LanguagesInUse As Collection
Set LanguagesInUse = New Collection

With ActiveDocument
Do While CurrentPosition < .Range.Characters.Count
CurrentLanguage = .Range.Characters(CurrentPosition).LanguageID
On Error Resume Next
LanguagesInUse.Add CurrentLanguage, CStr(CurrentLanguage)
If Err.Number = 457 Then
On Error GoTo 0
If CurrentPosition <> .Range.Characters.Count Then
CurrentPosition = CurrentPosition + 1
End If
Else
On Error GoTo 0
With .Range.Find
.ClearFormatting
.LanguageID = CurrentLanguage
.Replacement.ClearFormatting
.Text = "*"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End If
Loop

MsgBox LanguagesInUse.Count & " languages are used in this document"
.Undo LanguagesInUse.Count

End With

The text replacement (removal) leaves tables and maybe other structural,
rather than textual, components behind and getting the loop to end properly
proved a little tricky - I haven't done exhaustive testing and may have
missed something. I quite like the approach, though, as it ought to be
adaptable for other properties which can vary at individual character level
and which are difficult to work with, so may do some more work on it.

I would be interested in how it performs in a real situation compared to
whatever else you've tried.

 

[Mike Faulkner]

Helmut

You have provided me with a very interesting approach. Many thanks.

Regards
Mike

 

[Mike Faulkner]

Tony

Thank you for your code. What ever method is used every character will have
to be tested for LanguageID. In which case I'll probably use my method.

Many thanks for your time.

Regards
Mike