Option Explicit Const _DEBUG = 0 ' CalenderMain Public sCurLangLocale as String Public sCurCountryLocale as String ' Dieses Flag dient zur Abfrage ob die individuellen Daten abgespeichert werden sollen. Public bCalOwnDataChanged as Boolean 'BankHolidayFunctions Public CalBankholidayName$ (1 To 374) Public CalTypeOfBankHoliday% (1 To 374) Public Const cHolidayType_None = 0 Public Const cHolidayType_Full = 1 Public Const cHolidayType_Half = 2 Public Const cHolidayType_Own = 4 Public cCalSubcmdDeleteSelect_DeleteSelEntry$ Public cCalSubcmdDeleteSelect_DeleteSelEntryTitle$ Public cCalSubcmdSwitchOwnDataOrGeneral_Back$ Public cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ 'Language Public cCalLongMonthNames(11) as String Public cCalShortMonthNames(11) as String Public sBitmapFilename$ Public sCalendarTitle$, sMonthTitle$, sWizardTitle$, sError$ Public cCalStyleWorkday$, cCalStyleWeekend$ ' German only ' Variablen, die zur Verwaltung der Eingabe der Bundesländer dienen Public CalChoosenLand as Integer Public oDocument as Object Public oSheets as Object Public oSheet as Object Public oStatusLine as Object Public bCancelTask as Boolean ' BL* bedeutet BundesLand* Public CONST CalBLBayern = 1 Public CONST CalBLBadenWuert = 2 Public CONST CalBLBerlin = 3 Public CONST CalBLBremen = 4 Public CONST CalBLBrandenburg = 5 Public CONST CalBLHamburg = 6 Public CONST CalBLHessen = 7 Public CONST CalBLMeckPomm = 8 Public CONST CalBLNiedersachsen = 9 Public CONST CalBLNordrheinWest = 10 Public CONST CalBLRheinlandPfalz = 11 Public CONST CalBLSaarland = 12 Public CONST CalBLSachsen = 13 Public CONST CalBLSachsenAnhalt = 14 Public CONST CalBLSchlHolstein = 15 Public CONST CalBLThueringen = 16 Public DlgCalendar as Object Public DlgCalModel as Object Sub CalAutopilotTable() Dim BitmapDir as String Dim iThisMonth as Integer 'On Error Goto ErrorHandler BasicLibraries.LoadLibrary("Tools") bSelectByMouseMove = True oDocument = ThisComponent oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator ToggleWindow(False) sCurLangLocale = oDocument.CharLocale.Language sCurCountryLocale = oDocument.CharLocale.Country DlgCalendar = LoadDialog("Schedule", "DlgCalendar") DlgCalModel = DlgCalendar.Model LoadLanguage(sCurLangLocale) CalInitGlobalVariablesDate() BitmapDir = GetOfficeSubPath("Template","wizard/bitmap") DlgCalModel.imgCountry.ImageURL = BitmapDir & sBitmapFilename CalChoosenLand = -2 CurOwnMonth = -1 CalLoadOwnData() ' sCurLanguage = "ja" With DlgCalModel .cmdDelete.Enabled = False .lstMonth.StringItemList() = cCalShortMonthNames() Select Case sCurLangLocale Case "ja" .lstOwnData.FontName = "HG Mincho Light J" .txtEvent.FontName = "HG Mincho Light J" Case "zh" If oDocument.CharLocale.Country = "CN" Then .lstOwnData.FontName = "HG MSung Light SC" .txtEvent.FontName = "HG MSung Light SC" Else .lstOwnData.FontName = "HG MSung Light TC" .txtEvent.FontName = "HG MSung Light TC" End If Case "ko" .lstOwnData.FontName = "HG MyeongJo Light K" .txtEvent.FontName = "HG MyeongJo Light K" End Select .lstOwnEventMonth.StringItemList() = cCalShortMonthNames() .optYear.State = 1 .txtYear.Value = Year(Now()) .txtYear.Tag = .txtYear.Value .Step = 1 End With CalChooseCalendar() ' month iThisMonth = Month(Now) DlgCalendar.GetControl("lstMonth").SelectItemPos(iThisMonth-1, True) DlgCalendar.GetControl("lstHolidays").SelectItemPos(0,True) DlgCalModel.cmdGoOn.DefaultButton = True ToggleWindow(True) DlgCalendar.GetControl("lblHolidays").Visible = sCurLangLocale = cLANGUAGE_GERMAN DlgCalendar.GetControl("lstHolidays").Visible = sCurLangLocale = cLANGUAGE_GERMAN fHeightCorrFactor = DlgCalendar.GetControl("imgCountry").Size.Height/198 fWidthCorrFactor = DlgCalendar.GetControl("imgCountry").Size.Width/166 DlgCalendar.Execute() DlgCalendar.Dispose() Exit Sub ErrorHandler: MsgBox(sError$, 16, sWizardTitle$) End Sub Sub CalChooseCalendar() With DlgCalModel .lstMonth.Enabled = .optMonth.State = 1 .lblMonth.Enabled = .optMonth.State = 1 End With End Sub Sub CalcmdCancel() Call CalSaveOwnData() DlgCalendar.EndExecute ' Visible = False End Sub Sub CalcmdOk() ' cmdOk is called when the Button 'Read' is clicked on ' It is either given out a month or a year Dim i, iSelYear as Integer Dim SelYear as String ' DlgCalendar.Visible = False oSheets = oDocument.sheets Call CalSaveOwnData() UnprotectSheets(oSheets) oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) iSelYear = DlgCalModel.txtYear.Value Select Case sCurLangLocale Case cLANGUAGE_GERMAN If Ubound(DlgCalModel.lstHolidays.SelectedItems()) > -1 Then CalChoosenLand = DlgCalModel.lstHolidays.SelectedItems(0) Else CalChoosenLand = 0 End If Call CalFindWholeYearHolidays_GERMANY(iSelYear, CalChoosenLand) Case cLANGUAGE_ENGLISH Call FindWholeYearHolidays_US(iSelYear) Case cLANGUAGE_FRENCH Call FindWholeYearHolidays_FRANCE(iSelYear) Case cLANGUAGE_ITALIAN Call FindWholeYearHolidays_ITA(iSelYear) Case cLANGUAGE_SPANISH Call FindWholeYearHolidays_SPAIN(iSelYear) Case cLANGUAGE_PORTUGUESE Call FindWholeYearHolidays_PORT(iSelYear) Case cLANGUAGE_DUTCH Call FindWholeYearHolidays_NL(iSelYear) Case cLANGUAGE_SWEDISH Call FindWholeYearHolidays_SWED(iSelYear) Case cLANGUAGE_DANISH Call FindWholeYearHolidays_DK(iSelYear) Case cLANGUAGE_POLISH Call FindWholeYearHolidays_PL(iSelYear) Case cLANGUAGE_RUSSIAN Call FindWholeYearHolidays_RU(iSelYear) Case cLANGUAGE_JAPANESE Call FindWholeYearHolidays_JP(iSelYear) Case cLANGUAGE_CHINESE If sCurCountryLocale = "TW" Then Call FindWholeYearHolidays_TW(iSelYear) Else Call FindWholeYearHolidays_CN(iSelYear) End If End Select Call CalInsertOwnDataInTables(iSelYear) If DlgCalModel.optYear.State = 1 Then oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) oSheet = oSheets.GetbyIndex(0) oSheet.Name = sCalendarTitle$ + " " + iSelYear oDocument.AddActionLock Call CalCreateYearTable(iSelYear) ElseIf DlgCalModel.optMonth.State = 1 Then Dim iMonth iMonth = DlgCalModel.lstMonth.SelectedItems(0) + 1 oSheets.RemovebyName(oSheets.GetbyIndex(1).Name) oSheet = oSheets.GetbyIndex(0) If sMonthTitle = "" Then oSheet.Name = cCalLongMonthNames(iMonth-1) Else oSheet.Name = sMonthTitle + " " + cCalLongMonthNames(iMonth-1) End If oDocument.AddActionLock Call CalCreateMonthTable(iSelYear, iMonth) End If oDocument.RemoveActionLock oSheet.protect("") oStatusLine.End DlgCalendar.EndExecute() bCancelTask = True End Sub