ThisDocument 1 Option Explicit

---

ThisDocument - 1

 

Option Explicit

Private myRibbon As IRibbonUI

Private Sub Document_New()

On Error GoTo ErrorHandler

    

    #If MAC_OFFICE_VERSION >= 15 Then

        

        isMAC = True

        

    #Else

        

        isMAC = False

        Application.EnableCancelKey = wdCancelDisabled

    #End If

    

    frmSelectMonthAndYear.Show

Exit Sub

ErrorHandler:

MsgBox "Word не удалось отобразить диалоговое окно 'Выбрать даты'. Возможно, шаблон поврежден. Скач

айте его еще раз.", _

vbInformation + vbOKOnly, "Шаблон календаря Microsoft Word"

End Sub

Private Sub Document_Open()

On Error GoTo ErrorHandler

Dim resp As Integer

#If MAC_OFFICE_VERSION >= 15 Then

    

        isMAC = True

        

    #Else

        

        isMAC = False

        Application.EnableCancelKey = wdCancelDisabled

    #End If

'frmYesNo.Show

    

    frmSelectMonthAndYear.Show

'   resp = MsgBox("Вы хотели бы выбрать новые даты для этого календаря?", vbYesNo + vbQuestion, "Ка

лендарь Word")

'

'    If resp = vbYes Then

'        frmSelectMonthAndYear.Show

'    Else

        

        'MsgBox "Чтобы выбрать новые даты для календаря позднее, откройте вкладку "Календарь" и выб

ерите "Выбрать новые даты". Кроме того, вы можете воспользоваться клавишами SHIFT+OPTION+RETURN." &

 vbNewLine & vbNewLine & "Примечание. Нам известно, что вам может понадобиться внести изменения в э

тот календарь. Просто имейте в виду, что если вы редактируете даты или структуру таблицы, в Word мо

жет оказаться невозможным обновление дат.", vbInformation, "Календарь Word"

    'End If

Exit Sub

ErrorHandler:

MsgBox "Word не удалось отобразить диалоговое окно 'Выбрать даты'. Возможно, шаблон поврежден. Скач

айте его еще раз.", _

vbInformation + vbOKOnly, "Шаблон календаря Microsoft Word"

End Sub

Sub Ribbon_Load(ribbon As IRibbonUI)

    On Error Resume Next

    Set myRibbon = ribbon

    myRibbon.ActivateTab ("customTab")

End Sub

---

frmDialog - 1

 

Private Sub cmdOk_Click()

    Unload Me

End Sub

Private Sub lblMessage1_Click()

End Sub

Private Sub lblMessage2_Click()

End Sub

Private Sub UserForm_initialize()

    If isMAC Then

        lblMessage1.Caption = "Для вывода других дат откройте вкладку 'Календарь' и нажмите кнопку 

'Выбрать новые даты'. Кроме того, вы можете воспользоваться клавишами SHIFT+OPTION+RETURN."

        cmdOk.Accelerator = ""

        

    Else

    

        lblMessage1.Caption = "Для вывода других дат откройте вкладку 'Календарь' и нажмите кнопку 

'Выбрать новые даты'. Кроме того, вы можете воспользоваться клавишами SHIFT+ALT+ВВОД."

        cmdOk.Accelerator = "O"

    End If

End Sub

---

frmSelectMonthAndYear - 1

 

Option Explicit

Private iYear As Integer

Private Sub cmdCancel_Click()

    On Error Resume Next

    Unload Me

             

     frmDialog.Show

    'MsgBox "To select new dates for this calendar at a later time, go to the Calendar tab and then

 choose Select New Dates. Or, press Shift+Option+Return." & vbNewLine & vbNewLine & "Note: We know 

you might want to make changes to this calendar. Please just keep in mind, if you edit dates or tab

le structure, Word might be unable to update dates for you.", vbInformation, "Word Calendar"

End Sub

Private Sub cmdOk_Click()

On Error Resume Next

Dim iMonth As Integer

Dim dStartDate As Date

Dim i As Integer, iV As Integer

Dim Vars As Variables

Dim acl As Cell

Dim atb As Table

Dim cellTemp As Cell

If Val(cboSelectCalendarMonth) = 0 Then

 MsgBox "Необходимо выбрать месяц", vbExclamation, "Выбрано недопустимое значение"

 cboSelectCalendarMonth.DropDown

 Exit Sub

End If

If Val(cboSelectCalendarYear) = 0 Then

 MsgBox "Необходимо выбрать год", vbExclamation, "Выбрано недопустимое значение"

 cboSelectCalendarYear.DropDown

 Exit Sub

End If

Set Vars = ActiveDocument.Variables

iYear = frmSelectMonthAndYear.cboSelectCalendarYear

iMonth = frmSelectMonthAndYear.cboSelectCalendarMonth

'Get the first day of the month

 dStartDate = DateSerial(iYear, iMonth, 1)

'Update DocVariables with first day of month and last day of month

 Vars("MonthStart").Value = dStartDate

 'Vars("MonthEnd").Value = DateAdd("m", 1, dStartDate) - 1

 

 Vars("MonthEnd").Value = DateSerial(Year(dStartDate), Month(dStartDate) + 1, 0)

ActiveDocument.Fields.Update

On Error Resume Next

For i = 3 To ActiveDocument.Tables(3).Rows.Count Step 2

    For Each cellTemp In ActiveDocument.Tables(3).Rows(i).Cells

        cellTemp.Range.Delete

    Next

Next

Unload Me

frmDialog.Show

'MsgBox "To select new dates for this calendar at a later time, go to the Calendar tab and then cho

ose Select New Dates. Or, press Shift+Option+Return." & vbNewLine & vbNewLine & "Note: We know you 

might want to make changes to this calendar. Please just keep in mind, if you edit dates or table s

tructure, Word might be unable to update dates for you.", vbInformation, "Word Calendar"

End Sub

Private Sub labDates_Click()

End Sub

Private Sub lblSelectCalendarMonth_Click()

---

frmSelectMonthAndYear - 2

 

End Sub

Private Sub UserForm_initialize()

On Error GoTo End1

Dim i As Integer

Dim sMonth As String

cboSelectCalendarMonth.Clear

cboSelectCalendarYear.Clear

'Populate months

For i = 1 To 12

sMonth = Format(DateSerial(Year(Date), i, 1), "mmmm")

 With cboSelectCalendarMonth

  .AddItem

  .List(i - 1, 0) = sMonth

  .List(i - 1, 1) = i

  .SetFocus

 End With

 

Next i

  'cboSelectCalendarMonth.ListIndex = 0

  cboSelectCalendarMonth.ListIndex = (Month(Date) - 1)

'Populate years

 For i = Year(Date) To (Year(Date) + 10)

  cboSelectCalendarYear.AddItem i

 Next i

cboSelectCalendarYear.ListIndex = 0

If isMAC Then

    cmdCancel.Left = 132.5

    cmdCancel.TabIndex = 5

    cmdOk.Left = 216.5

    cmdCancel.Accelerator = ""

    cmdOk.Accelerator = ""

    cmdOk.TabIndex = 6

    lblSelectCalendarMonth.Accelerator = ""

    lblSelectCalendarYear.Accelerator = ""

Else

    cmdCancel.Left = 216.5

    cmdOk.TabIndex = 5

    cmdCancel.TabIndex = 6

    cmdOk.Left = 132.5

    cmdCancel.Accelerator = "C"

    cmdOk.Accelerator = "O"

    lblSelectCalendarMonth.Accelerator = "M"

    lblSelectCalendarYear.Accelerator = "Y"

End If

Exit Sub

End1:

 MsgBox Err.Description & " " & Err.Number

End Sub

---

CalMenus - 1

 

Option Explicit

Option Base 1

Public isMAC As Boolean

Sub CustomizeCalendar(ByVal Control As IRibbonControl)

frmSelectMonthAndYear.Show

End Sub

Sub CustomizeCalendarA()

frmSelectMonthAndYear.Show

End Sub