 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Word / Programming / October 2006Languages
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 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 [quoted text clipped - 7 lines] > Regards > Mike 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 > Mike, > [quoted text clipped - 69 lines] > > Regards > > Mike 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  SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" 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 > Hi Mike, > [quoted text clipped - 208 lines] > Win XP, Office 2003 > "red.sys" & Chr$(64) & "t-online.de" 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 > 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 [quoted text clipped - 270 lines] > > Win XP, Office 2003 > > "red.sys" & Chr$(64) & "t-online.de" Helmut You have provided me with a very interesting approach. Many thanks. Regards Mike > Hi Mike, > [quoted text clipped - 200 lines] > msoLanguageIDXhosa 1076 > msoLanguageIDZulu 1077 |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.