Languages

Prev: <Buffer for return string is too small>
Next: Add Watermark macro - Variable not defined

From: Mike Faulkner on 29 Sep 2006 05:10

---

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

From: karitaat on 29 Sep 2006 06:45

---

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:

> 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

From: Mike Faulkner on 29 Sep 2006 08:49

---

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


"karitaat(a)hotmail.com" wrote:

> 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:
>
> > 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
>
>

From: Helmut Weber on 29 Sep 2006 16:36

---

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

From: "Tony Jollans" my forename at my surname dot on 1 Oct 2006 10:19

---

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.

--
Enjoy,
Tony

"Helmut Weber" <nbhymsjxdgcn(a)mailinator.com> wrote in message
news:nqvqh2hrehau66vl0nepagc6rrvpifs3pu(a)4ax.com...
> 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
> mso

 |  Next  |  Last
Pages: 1 2
Prev: <Buffer for return string is too small>
Next: Add Watermark macro - Variable not defined