ThisDocument 1 Option Explicit



Yüklə 49,53 Kb.
Pdf görüntüsü
tarix31.12.2021
ölçüsü49,53 Kb.
#113083
Microsoft Visual Basic for Applications



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

Yüklə 49,53 Kb.

Dostları ilə paylaş:




Verilənlər bazası müəlliflik hüququ ilə müdafiə olunur ©muhaz.org 2024
rəhbərliyinə müraciət

gir | qeydiyyatdan keç
    Ana səhifə


yükləyin