1*cdf0e10cSrcweirAttribute VB_Name = "modWizard" 2*cdf0e10cSrcweir'/************************************************************************* 3*cdf0e10cSrcweir' * 4*cdf0e10cSrcweir' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 5*cdf0e10cSrcweir' 6*cdf0e10cSrcweir' Copyright 2000, 2010 Oracle and/or its affiliates. 7*cdf0e10cSrcweir' 8*cdf0e10cSrcweir' OpenOffice.org - a multi-platform office productivity suite 9*cdf0e10cSrcweir' 10*cdf0e10cSrcweir' This file is part of OpenOffice.org. 11*cdf0e10cSrcweir' 12*cdf0e10cSrcweir' OpenOffice.org is free software: you can redistribute it and/or modify 13*cdf0e10cSrcweir' it under the terms of the GNU Lesser General Public License version 3 14*cdf0e10cSrcweir' only, as published by the Free Software Foundation. 15*cdf0e10cSrcweir' 16*cdf0e10cSrcweir' OpenOffice.org is distributed in the hope that it will be useful, 17*cdf0e10cSrcweir' but WITHOUT ANY WARRANTY; without even the implied warranty of 18*cdf0e10cSrcweir' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19*cdf0e10cSrcweir' GNU Lesser General Public License version 3 for more details 20*cdf0e10cSrcweir' (a copy is included in the LICENSE file that accompanied this code). 21*cdf0e10cSrcweir' 22*cdf0e10cSrcweir' You should have received a copy of the GNU Lesser General Public License 23*cdf0e10cSrcweir' version 3 along with OpenOffice.org. If not, see 24*cdf0e10cSrcweir' <http://www.openoffice.org/license.html> 25*cdf0e10cSrcweir' for a copy of the LGPLv3 License. 26*cdf0e10cSrcweir' 27*cdf0e10cSrcweir' ************************************************************************/ 28*cdf0e10cSrcweirOption Explicit 29*cdf0e10cSrcweir 30*cdf0e10cSrcweirGlobal Const WIZARD_NAME = "Analysis" 31*cdf0e10cSrcweir 32*cdf0e10cSrcweir'Implementation details - not required for localisation 33*cdf0e10cSrcweirPublic Const CWORD_DRIVER_FILE = "_OOoDocAnalysisWordDriver.doc" 34*cdf0e10cSrcweirPublic Const CEXCEL_DRIVER_FILE = "_OOoDocAnalysisExcelDriver.xls" 35*cdf0e10cSrcweirPublic Const CPP_DRIVER_FILE = "_OOoDocAnalysisPPTDriver.ppt" 36*cdf0e10cSrcweirPublic Const CRESULTS_TEMPLATE_FILE = "results.xlt" 37*cdf0e10cSrcweirPublic Const CISSUES_LIST_FILE = "issues.list" 38*cdf0e10cSrcweirPublic Const CANALYSIS_INI_FILE = "analysis.ini" 39*cdf0e10cSrcweirPublic Const CLAUNCH_DRIVERS_EXE = "LaunchDrivers.exe" 40*cdf0e10cSrcweirPublic Const CMSO_KILL_EXE = "msokill.exe" 41*cdf0e10cSrcweirPublic Const CRESOURCE_DLL = "Resources.dll" 42*cdf0e10cSrcweir 43*cdf0e10cSrcweir' Preparation String ID's from DocAnalysisWizard.rc 44*cdf0e10cSrcweirPublic Const RID_STR_ENG_TITLE_PREP_ID = 1030 45*cdf0e10cSrcweirPublic Const RID_STR_ENG_SIDEBAR_ANALYZE_PREP_ID = 1074 46*cdf0e10cSrcweir 47*cdf0e10cSrcweirPublic Const RID_STR_ENG_INTRODUCTION_INTRO1_PREP_ID = 1131 48*cdf0e10cSrcweirPublic Const RID_STR_ENG_INTRODUCTION_INTRO2_PREP_ID = 1132 49*cdf0e10cSrcweirPublic Const RID_STR_ENG_INTRODUCTION_INTRO3_PREP_ID = 1134 50*cdf0e10cSrcweir 51*cdf0e10cSrcweirPublic Const RID_STR_ENG_DOCUMENTS_CHOOSE_DOCUMENTS_PREP_ID = 1230 52*cdf0e10cSrcweirPublic Const RID_STR_ENG_DOCUMENTS_CHOOSE_DOC_TYPES_PREP_ID = 1236 53*cdf0e10cSrcweirPublic Const RID_STR_ENG_DOCUMENTS_INCLUDE_SUBDIRECTORIES_PREP_ID = 1232 54*cdf0e10cSrcweir 55*cdf0e10cSrcweirPublic Const RID_STR_IGNORE_OLDER_CB_ID = 1231 56*cdf0e10cSrcweirPublic Const RID_STR_IGNORE_OLDER_3_MONTHS_ID = 1233 57*cdf0e10cSrcweirPublic Const RID_STR_IGNORE_OLDER_6_MONTHS_ID = 1234 58*cdf0e10cSrcweirPublic Const RID_STR_IGNORE_OLDER_12_MONTHS_ID = 1235 59*cdf0e10cSrcweir 60*cdf0e10cSrcweirPublic Const RID_STR_ENG_RESULTS_CHOOSE_OPTIONS_PREP_ID = 1330 61*cdf0e10cSrcweirPublic Const RID_STR_ENG_RESULTS_ANALYSIS_XLS_PREP_ID = 1332 62*cdf0e10cSrcweir 63*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYZE_NUM_DOCS_PREP_ID = 1431 64*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYZE_SETUP_COMPLETE_PREP_ID = 1430 65*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYZE_IGNORED_DOCS_ID = 1435 66*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYZE_START_ID = 1413 67*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYZE_COMPLETED_ID = 1412 68*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYZE_VIEW_NOW_ID = 1414 69*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYZE_VIEW_LATER_ID = 1415 70*cdf0e10cSrcweirPublic Const RID_STR_ENG_ANALYSE_NOT_RUN = 1416 71*cdf0e10cSrcweir 72*cdf0e10cSrcweirPublic Const RID_STR_ENG_OTHER_PLEASE_REFER_TO_README_PREP_ID = 1838 73*cdf0e10cSrcweirPublic Const RID_STR_ENG_OTHER_XML_RESULTS_PREP_ID = 1845 74*cdf0e10cSrcweirPublic Const RID_STR_ENG_OTHER_PREPARE_PROMPT_PREP_ID = 1846 75*cdf0e10cSrcweirPublic Const RID_STR_ENG_OTHER_PREPARE_COMPLETED_PREP_ID = 1847 76*cdf0e10cSrcweir 77*cdf0e10cSrcweir'Resource Strings Codes 78*cdf0e10cSrcweir' NOTE: to make a resource the default it must be the first string table inserted 79*cdf0e10cSrcweir' in the resource table - if it is not, just create several new string tables and 80*cdf0e10cSrcweir' copy what you want as default into the first new one you create, copy the others 81*cdf0e10cSrcweir' then delete the originals. 82*cdf0e10cSrcweir' 83*cdf0e10cSrcweir' To provide same string table for all English variants or all German variants 84*cdf0e10cSrcweir' I have added code to set LANG_BASE_ID dependent on current locale 85*cdf0e10cSrcweir' Refer to p.414 VBA in a Nutshell, Lomax 86*cdf0e10cSrcweir' I now have a single string table with each lang variant suitably offset: 87*cdf0e10cSrcweir' New locale - increase ofsets by 1000 - refer to DocAnalysisWizard.rc 88*cdf0e10cSrcweir' 89*cdf0e10cSrcweir' English - eng - Start at 1000 90*cdf0e10cSrcweir' German - ger - Start at 2000 91*cdf0e10cSrcweir' BrazilianPortugese - por - Start at 4000 92*cdf0e10cSrcweir' French - fre - Start at 5000 93*cdf0e10cSrcweir' Italian - ita - Start at 6000 94*cdf0e10cSrcweir' Spanish - spa - Start at 7000 95*cdf0e10cSrcweir' Swedish - swe - Start at 8000 96*cdf0e10cSrcweir 97*cdf0e10cSrcweir 98*cdf0e10cSrcweir' String ID's must match those in DocAnalysisWizard.rc 99*cdf0e10cSrcweirConst LANG_BASE_ID = 1000 100*cdf0e10cSrcweirConst INTERNAL_RESOURCE_BASE_ID = LANG_BASE_ID + 800 101*cdf0e10cSrcweir 102*cdf0e10cSrcweir' Setup Doc Preparation specific strings 103*cdf0e10cSrcweir#If PREPARATION Then 104*cdf0e10cSrcweirGlobal Const gBoolPreparation = True 105*cdf0e10cSrcweir 106*cdf0e10cSrcweirPublic Const TITLE_ID = RID_STR_ENG_TITLE_PREP_ID 107*cdf0e10cSrcweirPublic Const CHK_SUBDIRS_ID = RID_STR_ENG_DOCUMENTS_INCLUDE_SUBDIRECTORIES_PREP_ID 108*cdf0e10cSrcweirPublic Const SETUP_ANALYSIS_XLS_ID = RID_STR_ENG_RESULTS_ANALYSIS_XLS_PREP_ID 109*cdf0e10cSrcweirPublic Const ANALYZE_TOTAL_NUM_DOCS_ID = RID_STR_ENG_ANALYZE_NUM_DOCS_PREP_ID 110*cdf0e10cSrcweirPublic Const XML_RESULTS_ID = RID_STR_ENG_OTHER_XML_RESULTS_PREP_ID 111*cdf0e10cSrcweir 112*cdf0e10cSrcweir#Else 113*cdf0e10cSrcweirGlobal Const gBoolPreparation = False 114*cdf0e10cSrcweir 115*cdf0e10cSrcweirPublic Const TITLE_ID = LANG_BASE_ID + 0 116*cdf0e10cSrcweirPublic Const CHK_SUBDIRS_ID = LANG_BASE_ID + 202 117*cdf0e10cSrcweirPublic Const SETUP_ANALYSIS_XLS_ID = LANG_BASE_ID + 302 118*cdf0e10cSrcweirPublic Const ANALYZE_TOTAL_NUM_DOCS_ID = LANG_BASE_ID + 401 119*cdf0e10cSrcweirPublic Const XML_RESULTS_ID = INTERNAL_RESOURCE_BASE_ID + 15 120*cdf0e10cSrcweir#End If 121*cdf0e10cSrcweir 122*cdf0e10cSrcweirPublic Const PRODUCTNAME_ID = LANG_BASE_ID + 1 123*cdf0e10cSrcweirPublic Const LBL_STEPS_ID = LANG_BASE_ID + 40 124*cdf0e10cSrcweirPublic Const INTRO1_ID = LANG_BASE_ID + 101 125*cdf0e10cSrcweir 126*cdf0e10cSrcweirPublic Const ANALYZE_DOCUMENTS_ID = LANG_BASE_ID + 402 127*cdf0e10cSrcweirPublic Const ANALYZE_TEMPLATES_ID = LANG_BASE_ID + 403 128*cdf0e10cSrcweirPublic Const ANALYZE_DOCUMENTS_XLS_ID = LANG_BASE_ID + 408 129*cdf0e10cSrcweirPublic Const ANALYZE_DOCUMENTS_PPT_ID = LANG_BASE_ID + 409 130*cdf0e10cSrcweirPublic Const RUNBTN_START_ID = LANG_BASE_ID + 404 131*cdf0e10cSrcweirPublic Const PREPAREBTN_START_ID = LANG_BASE_ID + 411 132*cdf0e10cSrcweir 133*cdf0e10cSrcweirPublic Const README_FILE_ID = INTERNAL_RESOURCE_BASE_ID + 5 'Readme.doc 134*cdf0e10cSrcweirPublic Const BROWSE_FOR_DOC_DIR_ID = INTERNAL_RESOURCE_BASE_ID + 6 135*cdf0e10cSrcweirPublic Const BROWSE_FOR_RES_DIR_ID = INTERNAL_RESOURCE_BASE_ID + 7 136*cdf0e10cSrcweirPublic Const RUNBTN_RUNNING_ID = INTERNAL_RESOURCE_BASE_ID + 10 137*cdf0e10cSrcweir 138*cdf0e10cSrcweirPublic Const PROGRESS_CAPTION = INTERNAL_RESOURCE_BASE_ID + 20 139*cdf0e10cSrcweirPublic Const PROGRESS_ABORTING = INTERNAL_RESOURCE_BASE_ID + 21 140*cdf0e10cSrcweirPublic Const PROGRESS_PATH_LABEL = INTERNAL_RESOURCE_BASE_ID + 22 141*cdf0e10cSrcweirPublic Const PROGRESS_FILE_LABEL = INTERNAL_RESOURCE_BASE_ID + 23 142*cdf0e10cSrcweirPublic Const PROGRESS_INFO_LABEL = INTERNAL_RESOURCE_BASE_ID + 24 143*cdf0e10cSrcweirPublic Const PROGRESS_WAIT_LABEL = INTERNAL_RESOURCE_BASE_ID + 25 144*cdf0e10cSrcweir 145*cdf0e10cSrcweirPublic Const SEARCH_PATH_LABEL = PROGRESS_PATH_LABEL 146*cdf0e10cSrcweirPublic Const SEARCH_CAPTION = INTERNAL_RESOURCE_BASE_ID + 26 147*cdf0e10cSrcweirPublic Const SEARCH_INFO_LABEL = INTERNAL_RESOURCE_BASE_ID + 27 148*cdf0e10cSrcweirPublic Const SEARCH_FOUND_LABEL = INTERNAL_RESOURCE_BASE_ID + 28 149*cdf0e10cSrcweir 150*cdf0e10cSrcweirPublic Const TERMINATE_CAPTION = INTERNAL_RESOURCE_BASE_ID + 30 151*cdf0e10cSrcweirPublic Const TERMINATE_INFO = INTERNAL_RESOURCE_BASE_ID + 31 152*cdf0e10cSrcweirPublic Const TERMINATE_YES = INTERNAL_RESOURCE_BASE_ID + 32 153*cdf0e10cSrcweirPublic Const TERMINATE_NO = INTERNAL_RESOURCE_BASE_ID + 33 154*cdf0e10cSrcweir 155*cdf0e10cSrcweir'Error Resource Strings Codes 156*cdf0e10cSrcweirConst ERROR_BASE_ID = LANG_BASE_ID + 900 157*cdf0e10cSrcweirPublic Const ERR_MISSING_RESULTS_DOC = ERROR_BASE_ID + 0 158*cdf0e10cSrcweirPublic Const ERR_NO_DOC_DIR = ERROR_BASE_ID + 1 159*cdf0e10cSrcweirPublic Const ERR_NO_DOC_TYPES = ERROR_BASE_ID + 2 160*cdf0e10cSrcweirPublic Const ERR_NO_RES_DIR = ERROR_BASE_ID + 3 161*cdf0e10cSrcweirPublic Const ERR_CREATE_DIR = ERROR_BASE_ID + 4 162*cdf0e10cSrcweirPublic Const ERR_MISSING_RESULTS_TEMPLATE = ERROR_BASE_ID + 5 163*cdf0e10cSrcweirPublic Const ERR_MISSING_EXCEL_DRIVER = ERROR_BASE_ID + 6 164*cdf0e10cSrcweirPublic Const ERR_EXCEL_DRIVER_CRASH = ERROR_BASE_ID + 7 165*cdf0e10cSrcweirPublic Const ERR_MISSING_WORD_DRIVER = ERROR_BASE_ID + 8 166*cdf0e10cSrcweirPublic Const ERR_WORD_DRIVER_CRASH = ERROR_BASE_ID + 9 167*cdf0e10cSrcweirPublic Const ERR_MISSING_README = ERROR_BASE_ID + 10 168*cdf0e10cSrcweirPublic Const ERR_MISSING_PP_DRIVER = ERROR_BASE_ID + 11 169*cdf0e10cSrcweirPublic Const ERR_PP_DRIVER_CRASH = ERROR_BASE_ID + 12 170*cdf0e10cSrcweirPublic Const ERR_SUPPORTED_VERSION = ERROR_BASE_ID + 13 171*cdf0e10cSrcweirPublic Const ERR_ISSUES_VERSION_MISMATCH = ERROR_BASE_ID + 14 172*cdf0e10cSrcweirPublic Const ERR_ISSUES_LIST_MISSING = ERROR_BASE_ID + 15 173*cdf0e10cSrcweirPublic Const ERR_SUPPORTED_OSVERSION = ERROR_BASE_ID + 16 174*cdf0e10cSrcweirPublic Const ERR_OPEN_RESULTS_SPREADSHEET = ERROR_BASE_ID + 17 175*cdf0e10cSrcweirPublic Const ERR_EXCEL_OPEN = ERROR_BASE_ID + 18 176*cdf0e10cSrcweirPublic Const ERR_NO_ACCESS_TO_VBPROJECT = ERROR_BASE_ID + 19 177*cdf0e10cSrcweirPublic Const ERR_AUTOMATION_FAILURE = ERROR_BASE_ID + 20 178*cdf0e10cSrcweirPublic Const ERR_NO_RESULTS_DIRECTORY = ERROR_BASE_ID + 21 179*cdf0e10cSrcweirPublic Const ERR_CREATE_FILE = ERROR_BASE_ID + 22 180*cdf0e10cSrcweirPublic Const ERR_XML_RESULTS_ONLY = ERROR_BASE_ID + 23 181*cdf0e10cSrcweirPublic Const ERR_NOT_INSTALLED = ERROR_BASE_ID + 24 182*cdf0e10cSrcweirPublic Const ERR_CDROM_NOT_ALLOWED = ERROR_BASE_ID + 25 183*cdf0e10cSrcweirPublic Const ERR_CDROM_NOT_READY = ERROR_BASE_ID + 26 184*cdf0e10cSrcweirPublic Const ERR_NO_WRITE_TO_READ_ONLY_FOLDER = ERROR_BASE_ID + 27 185*cdf0e10cSrcweirPublic Const ERR_APPLICATION_IN_USE = ERROR_BASE_ID + 28 186*cdf0e10cSrcweirPublic Const ERR_MISSING_IMPORTANT_FILE = ERROR_BASE_ID + 29 187*cdf0e10cSrcweir 188*cdf0e10cSrcweir 189*cdf0e10cSrcweirPrivate Const LOCALE_ILANGUAGE As Long = &H1 'language id 190*cdf0e10cSrcweirPrivate Const LOCALE_SLANGUAGE As Long = &H2 'localized name of language 191*cdf0e10cSrcweirPrivate Const LOCALE_SENGLANGUAGE As Long = &H1001 'English name of language 192*cdf0e10cSrcweirPrivate Const LOCALE_SABBREVLANGNAME As Long = &H3 'abbreviated language name 193*cdf0e10cSrcweirPrivate Const LOCALE_SCOUNTRY As Long = &H6 'localized name of country 194*cdf0e10cSrcweirPrivate Const LOCALE_SENGCOUNTRY As Long = &H1002 'English name of country 195*cdf0e10cSrcweirPrivate Const LOCALE_SABBREVCTRYNAME As Long = &H7 'abbreviated country name 196*cdf0e10cSrcweirPrivate Const LOCALE_SISO639LANGNAME As Long = &H59 'ISO abbreviated language name 197*cdf0e10cSrcweirPrivate Const LOCALE_SISO3166CTRYNAME As Long = &H5A 'ISO abbreviated country name 198*cdf0e10cSrcweir 199*cdf0e10cSrcweirPrivate Const LOCALE_JAPAN As Long = &H411 200*cdf0e10cSrcweirPrivate Const LOCALE_KOREA As Long = &H412 201*cdf0e10cSrcweirPrivate Const LOCALE_ZH_CN As Long = &H404 202*cdf0e10cSrcweirPrivate Const LOCALE_ZH_TW As Long = &H804 203*cdf0e10cSrcweir 204*cdf0e10cSrcweirPrivate Const RES_PREFIX = ".\Resources\Resources.dll" 205*cdf0e10cSrcweir 206*cdf0e10cSrcweirDeclare Function GetLocaleInfo Lib "kernel32" Alias _ 207*cdf0e10cSrcweir"GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, _ 208*cdf0e10cSrcweirByVal cchData As Long) As Long 209*cdf0e10cSrcweir 210*cdf0e10cSrcweirDeclare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal fileName$) 211*cdf0e10cSrcweirDeclare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long 212*cdf0e10cSrcweirPrivate Declare Function LoadString Lib "user32" Alias "LoadStringA" _ 213*cdf0e10cSrcweir (ByVal hInstance As Long, ByVal wID As Long, ByVal lpBuffer As String, _ 214*cdf0e10cSrcweir ByVal nBufferMax As Long) As Long 215*cdf0e10cSrcweir 216*cdf0e10cSrcweir'WinHelp Commands 217*cdf0e10cSrcweir'Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long 218*cdf0e10cSrcweir'Public Const HELP_QUIT = &H2 ' Terminate help 219*cdf0e10cSrcweir'Public Const HELP_CONTENTS = &H3& ' Display index/contents 220*cdf0e10cSrcweir'Public Const HELP_CONTEXT = &H1 ' Display topic in ulTopic 221*cdf0e10cSrcweir'Public Const HELP_INDEX = &H3 ' Display index 222*cdf0e10cSrcweir 223*cdf0e10cSrcweirPublic Const CBASE_RESOURCE_DIR = ".\resources" 224*cdf0e10cSrcweirPrivate mStrTrue As String 225*cdf0e10cSrcweirPrivate mLocaleDir As String 226*cdf0e10cSrcweirPrivate ghInst As Long 227*cdf0e10cSrcweir 228*cdf0e10cSrcweir 229*cdf0e10cSrcweirFunction getLocaleDir() As String 230*cdf0e10cSrcweir If mLocaleDir = "" Then 231*cdf0e10cSrcweir getLocaleLangBaseIDandSetLocaleDir 232*cdf0e10cSrcweir End If 233*cdf0e10cSrcweir getLocaleDir = mLocaleDir 234*cdf0e10cSrcweirEnd Function 235*cdf0e10cSrcweir 236*cdf0e10cSrcweirPublic Function GetLocaleLanguage() As String 237*cdf0e10cSrcweir Dim lReturn As Long 238*cdf0e10cSrcweir Dim lLocID As Long 239*cdf0e10cSrcweir Dim sData As String 240*cdf0e10cSrcweir Dim lDataLen As Long 241*cdf0e10cSrcweir 242*cdf0e10cSrcweir lDataLen = 0 243*cdf0e10cSrcweir lReturn = GetLocaleInfo(lLocID, LOCALE_SENGLANGUAGE, sData, lDataLen) 244*cdf0e10cSrcweir sData = String(lReturn, 0) & vbNullChar 245*cdf0e10cSrcweir lDataLen = lReturn 246*cdf0e10cSrcweir lReturn = GetLocaleInfo(lLocID, LOCALE_SENGLANGUAGE, sData, lDataLen) 247*cdf0e10cSrcweir 248*cdf0e10cSrcweirEnd Function 249*cdf0e10cSrcweir 250*cdf0e10cSrcweirFunction getLocaleLangBaseIDandSetLocaleDir() As Integer 251*cdf0e10cSrcweir On Error GoTo HandleErrors 252*cdf0e10cSrcweir Dim currentFunctionName As String 253*cdf0e10cSrcweir currentFunctionName = "getLocaleLangBaseIDandSetLocaleDir" 254*cdf0e10cSrcweir 255*cdf0e10cSrcweir Dim baseID As Long 256*cdf0e10cSrcweir Dim bUseLocale As Boolean 257*cdf0e10cSrcweir Dim fso As FileSystemObject 258*cdf0e10cSrcweir Set fso = New FileSystemObject 259*cdf0e10cSrcweir 260*cdf0e10cSrcweir Dim isoLangStr As String 261*cdf0e10cSrcweir Dim isoCountryStr As String 262*cdf0e10cSrcweir Dim langStr As String 263*cdf0e10cSrcweir 264*cdf0e10cSrcweir Dim userLCID As Long 265*cdf0e10cSrcweir userLCID = GetUserDefaultLCID() 266*cdf0e10cSrcweir Dim sysLCID As Long 267*cdf0e10cSrcweir sysLCID = GetSystemDefaultLCID() 268*cdf0e10cSrcweir 269*cdf0e10cSrcweir isoLangStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME) 270*cdf0e10cSrcweir isoCountryStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME) 271*cdf0e10cSrcweir langStr = GetUserLocaleInfo(sysLCID, LOCALE_SENGLANGUAGE) 272*cdf0e10cSrcweir 273*cdf0e10cSrcweir baseID = 0 274*cdf0e10cSrcweir mLocaleDir = "" 275*cdf0e10cSrcweir 276*cdf0e10cSrcweir If fso.FileExists(fso.GetAbsolutePathName("debug.ini")) Then 277*cdf0e10cSrcweir Dim overrideLangStr As String 278*cdf0e10cSrcweir overrideLangStr = ProfileGetItem("debug", "langoverride", "", fso.GetAbsolutePathName("debug.ini")) 279*cdf0e10cSrcweir If overrideLangStr <> "" Then 280*cdf0e10cSrcweir Debug.Print "Overriding language " & isoLangStr & " with " & overrideLangStr & "\n" 281*cdf0e10cSrcweir isoLangStr = overrideLangStr 282*cdf0e10cSrcweir End If 283*cdf0e10cSrcweir End If 284*cdf0e10cSrcweir 285*cdf0e10cSrcweir 'check for locale dirs in following order: 286*cdf0e10cSrcweir ' CBASE_RESOURCE_DIR & "\" & isoLangStr 287*cdf0e10cSrcweir ' CBASE_RESOURCE_DIR & "\" & isoLangStr & "-" & isoCountryStr 288*cdf0e10cSrcweir ' CBASE_RESOURCE_DIR & "\" & "eng" 289*cdf0e10cSrcweir 'If fso.FolderExists(fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & isoLangStr)) Then 290*cdf0e10cSrcweir ' mLocaleDir = CBASE_RESOURCE_DIR & "\" & isoLangStr 291*cdf0e10cSrcweir ' baseID = getBaseID(isoLangStr) 292*cdf0e10cSrcweir 'ElseIf fso.FolderExists(fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & isoLangStr & "-" & isoCountryStr)) Then 293*cdf0e10cSrcweir ' mLocaleDir = CBASE_RESOURCE_DIR & "\" & isoLangStr & "-" & isoCountryStr 294*cdf0e10cSrcweir ' baseID = getBaseID(isoLangStr & "-" & isoCountryStr) 295*cdf0e10cSrcweir 'Else 296*cdf0e10cSrcweir mLocaleDir = CBASE_RESOURCE_DIR 297*cdf0e10cSrcweir baseID = 1000 298*cdf0e10cSrcweir 'End If 299*cdf0e10cSrcweir 300*cdf0e10cSrcweir getLocaleLangBaseIDandSetLocaleDir = CInt(baseID) 301*cdf0e10cSrcweir 302*cdf0e10cSrcweirFinalExit: 303*cdf0e10cSrcweir Set fso = Nothing 304*cdf0e10cSrcweir 305*cdf0e10cSrcweir Exit Function 306*cdf0e10cSrcweir 307*cdf0e10cSrcweirHandleErrors: 308*cdf0e10cSrcweir Debug.Print currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 309*cdf0e10cSrcweir Resume FinalExit 310*cdf0e10cSrcweirEnd Function 311*cdf0e10cSrcweir'-------------------------------------------------------------------------- 312*cdf0e10cSrcweir'this sub must be executed from the immediate window 313*cdf0e10cSrcweir'it will add the entry to VBADDIN.INI if it doesn't already exist 314*cdf0e10cSrcweir'so that the add-in is on available next time VB is loaded 315*cdf0e10cSrcweir'-------------------------------------------------------------------------- 316*cdf0e10cSrcweirSub AddToINI() 317*cdf0e10cSrcweir Debug.Print WritePrivateProfileString("Add-Ins32", WIZARD_NAME & ".Wizard", "0", "VBADDIN.INI") 318*cdf0e10cSrcweirEnd Sub 319*cdf0e10cSrcweir 320*cdf0e10cSrcweirFunction GetResString(nRes As Integer) As String 321*cdf0e10cSrcweir Dim sTmp As String 322*cdf0e10cSrcweir Dim sRes As String * 1024 323*cdf0e10cSrcweir Dim sRetStr As String 324*cdf0e10cSrcweir Dim nRet As Long 325*cdf0e10cSrcweir 326*cdf0e10cSrcweir Do 327*cdf0e10cSrcweir 'sTmp = LoadResString(nRes) 328*cdf0e10cSrcweir nRet = LoadString(ghInst, nRes, sRes, 1024) 329*cdf0e10cSrcweir sTmp = Left$(sRes, nRet) 330*cdf0e10cSrcweir 331*cdf0e10cSrcweir If Right(sTmp, 1) = "_" Then 332*cdf0e10cSrcweir sRetStr = sRetStr + VBA.Left(sTmp, Len(sTmp) - 1) 333*cdf0e10cSrcweir Else 334*cdf0e10cSrcweir sRetStr = sRetStr + sTmp 335*cdf0e10cSrcweir End If 336*cdf0e10cSrcweir nRes = nRes + 1 337*cdf0e10cSrcweir Loop Until Right(sTmp, 1) <> "_" 338*cdf0e10cSrcweir GetResString = sRetStr 339*cdf0e10cSrcweir 340*cdf0e10cSrcweirEnd Function 341*cdf0e10cSrcweir 342*cdf0e10cSrcweirFunction GetField(sBuffer As String, sSep As String) As String 343*cdf0e10cSrcweir Dim p As Integer 344*cdf0e10cSrcweir 345*cdf0e10cSrcweir p = InStr(sBuffer & sSep, sSep) 346*cdf0e10cSrcweir GetField = VBA.Left(sBuffer, p - 1) 347*cdf0e10cSrcweir sBuffer = Mid(sBuffer, p + Len(sSep)) 348*cdf0e10cSrcweir 349*cdf0e10cSrcweirEnd Function 350*cdf0e10cSrcweir' Parts of the following code are from: 351*cdf0e10cSrcweir' http://support.microsoft.com/default.aspx?scid=kb;en-us;232625&Product=vb6 352*cdf0e10cSrcweir 353*cdf0e10cSrcweirPrivate Function GetCharSet(sCdpg As String) As Integer 354*cdf0e10cSrcweir Select Case sCdpg 355*cdf0e10cSrcweir Case "932" ' Japanese 356*cdf0e10cSrcweir GetCharSet = 128 357*cdf0e10cSrcweir Case "936" ' Simplified Chinese 358*cdf0e10cSrcweir GetCharSet = 134 359*cdf0e10cSrcweir Case "949" ' Korean 360*cdf0e10cSrcweir GetCharSet = 129 361*cdf0e10cSrcweir Case "950" ' Traditional Chinese 362*cdf0e10cSrcweir GetCharSet = 136 363*cdf0e10cSrcweir Case "1250" ' Eastern Europe 364*cdf0e10cSrcweir GetCharSet = 238 365*cdf0e10cSrcweir Case "1251" ' Russian 366*cdf0e10cSrcweir GetCharSet = 204 367*cdf0e10cSrcweir Case "1252" ' Western European Languages 368*cdf0e10cSrcweir GetCharSet = 0 369*cdf0e10cSrcweir Case "1253" ' Greek 370*cdf0e10cSrcweir GetCharSet = 161 371*cdf0e10cSrcweir Case "1254" ' Turkish 372*cdf0e10cSrcweir GetCharSet = 162 373*cdf0e10cSrcweir Case "1255" ' Hebrew 374*cdf0e10cSrcweir GetCharSet = 177 375*cdf0e10cSrcweir Case "1256" ' Arabic 376*cdf0e10cSrcweir GetCharSet = 178 377*cdf0e10cSrcweir Case "1257" ' Baltic 378*cdf0e10cSrcweir GetCharSet = 186 379*cdf0e10cSrcweir Case Else 380*cdf0e10cSrcweir GetCharSet = 0 381*cdf0e10cSrcweir End Select 382*cdf0e10cSrcweirEnd Function 383*cdf0e10cSrcweir 384*cdf0e10cSrcweirPrivate Function StripNullTerminator(sCP As String) 385*cdf0e10cSrcweir Dim posNull As Long 386*cdf0e10cSrcweir posNull = InStr(sCP, Chr$(0)) 387*cdf0e10cSrcweir StripNullTerminator = Left$(sCP, posNull - 1) 388*cdf0e10cSrcweirEnd Function 389*cdf0e10cSrcweir 390*cdf0e10cSrcweirPrivate Function GetResourceDataFileName() As String 391*cdf0e10cSrcweir On Error GoTo HandleErrors 392*cdf0e10cSrcweir Dim currentFunctionName As String 393*cdf0e10cSrcweir currentFunctionName = "GetResourceDataFileName" 394*cdf0e10cSrcweir 395*cdf0e10cSrcweir Dim fileName As String 396*cdf0e10cSrcweir Dim fso As FileSystemObject 397*cdf0e10cSrcweir Set fso = New FileSystemObject 398*cdf0e10cSrcweir 399*cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(RES_PREFIX) 400*cdf0e10cSrcweir 401*cdf0e10cSrcweir GoTo FinalExit 402*cdf0e10cSrcweir 403*cdf0e10cSrcweir ' use the following code when we have one resource file for each language 404*cdf0e10cSrcweir Dim isoLangStr As String 405*cdf0e10cSrcweir Dim isoCountryStr As String 406*cdf0e10cSrcweir 407*cdf0e10cSrcweir Dim userLCID As Long 408*cdf0e10cSrcweir userLCID = GetUserDefaultLangID() 409*cdf0e10cSrcweir Dim sysLCID As Long 410*cdf0e10cSrcweir sysLCID = GetSystemDefaultLangID() 411*cdf0e10cSrcweir 412*cdf0e10cSrcweir isoLangStr = GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME) 413*cdf0e10cSrcweir isoCountryStr = GetUserLocaleInfo(userLCID, LOCALE_SISO3166CTRYNAME) 414*cdf0e10cSrcweir 415*cdf0e10cSrcweir 'check for locale data in following order: 416*cdf0e10cSrcweir ' user language 417*cdf0e10cSrcweir ' isoLangStr & "_" & isoCountryStr & ".dll" 418*cdf0e10cSrcweir ' isoLangStr & ".dll" 419*cdf0e10cSrcweir ' system language 420*cdf0e10cSrcweir ' isoLangStr & "_" & isoCountryStr & ".dll" 421*cdf0e10cSrcweir ' isoLangStr & ".dll" 422*cdf0e10cSrcweir ' "en_US" & ".dll" 423*cdf0e10cSrcweir 424*cdf0e10cSrcweir fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & "-" & isoCountryStr & ".dll") 425*cdf0e10cSrcweir If fso.FileExists(fileName) Then 426*cdf0e10cSrcweir GetResourceDataFileName = fileName 427*cdf0e10cSrcweir Else 428*cdf0e10cSrcweir fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & ".dll") 429*cdf0e10cSrcweir If fso.FileExists(fileName) Then 430*cdf0e10cSrcweir GetResourceDataFileName = fileName 431*cdf0e10cSrcweir Else 432*cdf0e10cSrcweir isoLangStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME) 433*cdf0e10cSrcweir isoCountryStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME) 434*cdf0e10cSrcweir 435*cdf0e10cSrcweir fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & "-" & isoCountryStr & ".dll") 436*cdf0e10cSrcweir If fso.FileExists(fileName) Then 437*cdf0e10cSrcweir GetResourceDataFileName = fileName 438*cdf0e10cSrcweir Else 439*cdf0e10cSrcweir fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & ".dll") 440*cdf0e10cSrcweir If fso.FileExists(fileName) Then 441*cdf0e10cSrcweir GetResourceDataFileName = fileName 442*cdf0e10cSrcweir Else 443*cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(RES_PREFIX & "en-US.dll") 444*cdf0e10cSrcweir End If 445*cdf0e10cSrcweir End If 446*cdf0e10cSrcweir End If 447*cdf0e10cSrcweir End If 448*cdf0e10cSrcweirFinalExit: 449*cdf0e10cSrcweir Set fso = Nothing 450*cdf0e10cSrcweir Exit Function 451*cdf0e10cSrcweir 452*cdf0e10cSrcweirHandleErrors: 453*cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 454*cdf0e10cSrcweir Resume FinalExit 455*cdf0e10cSrcweirEnd Function 456*cdf0e10cSrcweir 457*cdf0e10cSrcweirSub LoadResStrings(frm As Form) 458*cdf0e10cSrcweir Dim ctl As Control 459*cdf0e10cSrcweir Dim obj As Object 460*cdf0e10cSrcweir 461*cdf0e10cSrcweir Dim LCID As Long, X As Long 462*cdf0e10cSrcweir Dim sCodePage As String 463*cdf0e10cSrcweir Dim nCharSet As Integer 464*cdf0e10cSrcweir Dim currentFunctionName As String 465*cdf0e10cSrcweir currentFunctionName = "LoadResStrings" 466*cdf0e10cSrcweir 467*cdf0e10cSrcweir On Error GoTo HandleErrors 468*cdf0e10cSrcweir ghInst = LoadLibrary(GetResourceDataFileName()) 469*cdf0e10cSrcweir 470*cdf0e10cSrcweir On Error Resume Next 471*cdf0e10cSrcweir 472*cdf0e10cSrcweir sCodePage = String$(16, " ") 473*cdf0e10cSrcweir LCID = GetThreadLocale() 'Get Current locale 474*cdf0e10cSrcweir 475*cdf0e10cSrcweir X = GetLocaleInfo(LCID, LOCALE_IDEFAULTANSICODEPAGE, _ 476*cdf0e10cSrcweir sCodePage, Len(sCodePage)) 'Get code page 477*cdf0e10cSrcweir sCodePage = StripNullTerminator(sCodePage) 478*cdf0e10cSrcweir nCharSet = GetCharSet(sCodePage) 'Convert code page to charset 479*cdf0e10cSrcweir 480*cdf0e10cSrcweir 'set the form's caption 481*cdf0e10cSrcweir If IsNumeric(frm.Tag) Then 482*cdf0e10cSrcweir frm.Caption = LoadResString(CInt(frm.Tag)) 483*cdf0e10cSrcweir End If 484*cdf0e10cSrcweir 485*cdf0e10cSrcweir 'set the controls' captions using the caption 486*cdf0e10cSrcweir 'property for menu items and the Tag property 487*cdf0e10cSrcweir 'for all other controls 488*cdf0e10cSrcweir For Each ctl In frm.Controls 489*cdf0e10cSrcweir Err = 0 490*cdf0e10cSrcweir If (nCharSet <> 0) Then 491*cdf0e10cSrcweir ctl.Font.Charset = nCharSet 492*cdf0e10cSrcweir End If 493*cdf0e10cSrcweir If TypeName(ctl) = "Menu" Then 494*cdf0e10cSrcweir If IsNumeric(ctl.Caption) Then 495*cdf0e10cSrcweir ctl.Caption = LoadResString(CInt(ctl.Caption)) 496*cdf0e10cSrcweir End If 497*cdf0e10cSrcweir ElseIf TypeName(ctl) = "TabStrip" Then 498*cdf0e10cSrcweir For Each obj In ctl.Tabs 499*cdf0e10cSrcweir If IsNumeric(obj.Tag) Then 500*cdf0e10cSrcweir obj.Caption = LoadResString(CInt(obj.Tag)) 501*cdf0e10cSrcweir End If 502*cdf0e10cSrcweir 'check for a tooltip 503*cdf0e10cSrcweir If IsNumeric(obj.ToolTipText) Then 504*cdf0e10cSrcweir If Err = 0 Then 505*cdf0e10cSrcweir obj.ToolTipText = LoadResString(CInt(obj.ToolTipText)) 506*cdf0e10cSrcweir End If 507*cdf0e10cSrcweir End If 508*cdf0e10cSrcweir Next 509*cdf0e10cSrcweir ElseIf TypeName(ctl) = "Toolbar" Then 510*cdf0e10cSrcweir For Each obj In ctl.Buttons 511*cdf0e10cSrcweir If IsNumeric(obj.Tag) Then 512*cdf0e10cSrcweir obj.ToolTipText = LoadResString(CInt(obj.Tag)) 513*cdf0e10cSrcweir End If 514*cdf0e10cSrcweir Next 515*cdf0e10cSrcweir ElseIf TypeName(ctl) = "ListView" Then 516*cdf0e10cSrcweir For Each obj In ctl.ColumnHeaders 517*cdf0e10cSrcweir If IsNumeric(obj.Tag) Then 518*cdf0e10cSrcweir obj.Text = LoadResString(CInt(obj.Tag)) 519*cdf0e10cSrcweir End If 520*cdf0e10cSrcweir Next 521*cdf0e10cSrcweir ElseIf TypeName(ctl) = "TextBox" Then 522*cdf0e10cSrcweir If IsNumeric(ctl.Tag) Then 523*cdf0e10cSrcweir ctl.Text = LoadResString(CInt(ctl.Tag)) 524*cdf0e10cSrcweir End If 525*cdf0e10cSrcweir Else 526*cdf0e10cSrcweir If IsNumeric(ctl.Tag) Then 527*cdf0e10cSrcweir ctl.Caption = GetResString(CInt(ctl.Tag)) 528*cdf0e10cSrcweir End If 529*cdf0e10cSrcweir 'check for a tooltip 530*cdf0e10cSrcweir If IsNumeric(ctl.ToolTipText) Then 531*cdf0e10cSrcweir If Err = 0 Then 532*cdf0e10cSrcweir ctl.ToolTipText = LoadResString(CInt(ctl.ToolTipText)) 533*cdf0e10cSrcweir End If 534*cdf0e10cSrcweir End If 535*cdf0e10cSrcweir End If 536*cdf0e10cSrcweir Next 537*cdf0e10cSrcweir 538*cdf0e10cSrcweirFinalExit: 539*cdf0e10cSrcweir Exit Sub 540*cdf0e10cSrcweir 541*cdf0e10cSrcweirHandleErrors: 542*cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 543*cdf0e10cSrcweir Resume FinalExit 544*cdf0e10cSrcweir 545*cdf0e10cSrcweirEnd Sub 546*cdf0e10cSrcweir 547*cdf0e10cSrcweir'================================================== 548*cdf0e10cSrcweir'Purpose: Replace the sToken string(s) in 549*cdf0e10cSrcweir' res file string for correct placement 550*cdf0e10cSrcweir' of localized tokens 551*cdf0e10cSrcweir' 552*cdf0e10cSrcweir'Inputs: sString = String to search and replace in 553*cdf0e10cSrcweir' sToken = token to replace 554*cdf0e10cSrcweir' sReplacement = String to replace token with 555*cdf0e10cSrcweir' 556*cdf0e10cSrcweir'Outputs: New string with token replaced throughout 557*cdf0e10cSrcweir'================================================== 558*cdf0e10cSrcweirFunction ReplaceTopicTokens(sString As String, _ 559*cdf0e10cSrcweir sToken As String, _ 560*cdf0e10cSrcweir sReplacement As String) As String 561*cdf0e10cSrcweir On Error Resume Next 562*cdf0e10cSrcweir 563*cdf0e10cSrcweir Dim p As Integer 564*cdf0e10cSrcweir Dim sTmp As String 565*cdf0e10cSrcweir 566*cdf0e10cSrcweir sTmp = sString 567*cdf0e10cSrcweir Do 568*cdf0e10cSrcweir p = InStr(sTmp, sToken) 569*cdf0e10cSrcweir If p Then 570*cdf0e10cSrcweir sTmp = VBA.Left(sTmp, p - 1) + sReplacement + Mid(sTmp, p + Len(sToken)) 571*cdf0e10cSrcweir End If 572*cdf0e10cSrcweir Loop While p 573*cdf0e10cSrcweir 574*cdf0e10cSrcweir 575*cdf0e10cSrcweir ReplaceTopicTokens = sTmp 576*cdf0e10cSrcweir 577*cdf0e10cSrcweirEnd Function 578*cdf0e10cSrcweir'================================================== 579*cdf0e10cSrcweir'Purpose: Replace the sToken1 and sToken2 strings in 580*cdf0e10cSrcweir' res file string for correct placement 581*cdf0e10cSrcweir' of localized tokens 582*cdf0e10cSrcweir' 583*cdf0e10cSrcweir'Inputs: sString = String to search and replace in 584*cdf0e10cSrcweir' sToken1 = 1st token to replace 585*cdf0e10cSrcweir' sReplacement1 = 1st String to replace token with 586*cdf0e10cSrcweir' sToken2 = 2nd token to replace 587*cdf0e10cSrcweir' sReplacement2 = 2nd String to replace token with 588*cdf0e10cSrcweir' 589*cdf0e10cSrcweir'Outputs: New string with token replaced throughout 590*cdf0e10cSrcweir'================================================== 591*cdf0e10cSrcweirFunction ReplaceTopic2Tokens(sString As String, _ 592*cdf0e10cSrcweir sToken1 As String, _ 593*cdf0e10cSrcweir sReplacement1 As String, _ 594*cdf0e10cSrcweir sToken2 As String, _ 595*cdf0e10cSrcweir sReplacement2 As String) As String 596*cdf0e10cSrcweir On Error Resume Next 597*cdf0e10cSrcweir 598*cdf0e10cSrcweir ReplaceTopic2Tokens = _ 599*cdf0e10cSrcweir ReplaceTopicTokens(ReplaceTopicTokens(sString, sToken1, sReplacement1), _ 600*cdf0e10cSrcweir sToken2, sReplacement2) 601*cdf0e10cSrcweirEnd Function 602*cdf0e10cSrcweir 603*cdf0e10cSrcweir 604*cdf0e10cSrcweirPublic Function GetResData(sResName As String, sResType As String) As String 605*cdf0e10cSrcweir Dim sTemp As String 606*cdf0e10cSrcweir Dim p As Integer 607*cdf0e10cSrcweir 608*cdf0e10cSrcweir sTemp = StrConv(LoadResData(sResName, sResType), vbUnicode) 609*cdf0e10cSrcweir p = InStr(sTemp, vbNullChar) 610*cdf0e10cSrcweir If p Then sTemp = VBA.Left$(sTemp, p - 1) 611*cdf0e10cSrcweir GetResData = sTemp 612*cdf0e10cSrcweirEnd Function 613*cdf0e10cSrcweir 614*cdf0e10cSrcweirFunction AddToAddInCommandBar(VBInst As Object, sCaption As String, oBitmap As Object) As Object 'Office.CommandBarControl 615*cdf0e10cSrcweir On Error GoTo AddToAddInCommandBarErr 616*cdf0e10cSrcweir 617*cdf0e10cSrcweir Dim c As Integer 618*cdf0e10cSrcweir Dim cbMenuCommandBar As Object 'Office.CommandBarControl 'command bar object 619*cdf0e10cSrcweir Dim cbMenu As Object 620*cdf0e10cSrcweir 621*cdf0e10cSrcweir 'see if we can find the Add-Ins menu 622*cdf0e10cSrcweir Set cbMenu = VBInst.CommandBars("Add-Ins") 623*cdf0e10cSrcweir If cbMenu Is Nothing Then 624*cdf0e10cSrcweir 'not available so we fail 625*cdf0e10cSrcweir Exit Function 626*cdf0e10cSrcweir End If 627*cdf0e10cSrcweir 628*cdf0e10cSrcweir 'add it to the command bar 629*cdf0e10cSrcweir Set cbMenuCommandBar = cbMenu.Controls.add(1) 630*cdf0e10cSrcweir c = cbMenu.Controls.count - 1 631*cdf0e10cSrcweir If cbMenu.Controls(c).BeginGroup And _ 632*cdf0e10cSrcweir Not cbMenu.Controls(c - 1).BeginGroup Then 633*cdf0e10cSrcweir 'this s the first addin being added so it needs a separator 634*cdf0e10cSrcweir cbMenuCommandBar.BeginGroup = True 635*cdf0e10cSrcweir End If 636*cdf0e10cSrcweir 'set the caption 637*cdf0e10cSrcweir cbMenuCommandBar.Caption = sCaption 638*cdf0e10cSrcweir 'undone:set the onaction (required at this point) 639*cdf0e10cSrcweir cbMenuCommandBar.OnAction = "hello" 640*cdf0e10cSrcweir 'copy the icon to the clipboard 641*cdf0e10cSrcweir Clipboard.SetData oBitmap 642*cdf0e10cSrcweir 'set the icon for the button 643*cdf0e10cSrcweir cbMenuCommandBar.PasteFace 644*cdf0e10cSrcweir 645*cdf0e10cSrcweir Set AddToAddInCommandBar = cbMenuCommandBar 646*cdf0e10cSrcweir 647*cdf0e10cSrcweir Exit Function 648*cdf0e10cSrcweirAddToAddInCommandBarErr: 649*cdf0e10cSrcweir 650*cdf0e10cSrcweirEnd Function 651*cdf0e10cSrcweir 652