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