Приклади макросів ms Office
Задача. Створити макрос Word, за допомогою якого активний документ друкується у вигляді брошури. На кожному листи формату А4 друкувати 4 сторінки формату А5 таким чином, щоб документ можна було скласти у книжку. Кількість сторінок у брошурі кратна 4. Зауважимо, що даний посібник друкувався за допомогою наведеного нижче макросу (параметри сторінки: поля – дзеркальні, формат – А5, орієнтація – книжна ).
Sub ДрукПосібника()
Dim s As String, i, n, add As Integer
s = InputBox("Введіть кількість сторінок у брошурі", _
"Макрос друку брошури")
If s = "" Then Exit Sub
If Not IsNumeric(s) Then Exit Sub
n = Val(s) 'кількість сторінок
' визначення кількості додаткових порожніх сторінок
If (n Mod 4) <> 0 Then add = 4 - (n Mod 4) Else add = 0
' добалення в кінець документу порожніх сторінок
Selection.EndKey Unit:=wdStory
For i = 1 To add
Selection.InsertBreak Type:=wdPageBreak
Next
n = n + add: s = ""
i = MsgBox("Друкувати верхню сторону листів ?”+ _
” (Yes - верхню, No - нижню)", _
vbYesNo + vbQuestion, "Вибір першого чи другого проходу друку")
If i = vbYes Then
'перший прохід друку
For i = 1 To n / 2 Step 2
' формування списку номерів для друку одної сторони листів
s = s + Str(n - i + 1) + "," + Str(i) + ","
Next
' знищення зайвої коми в кінці списку
s = Left(s, Len(s) - 1)
i=MsgBox ("Закладіть у прінтер " + Str(n / 4) + _
" листів для друку сторінок з номерами " + s + _
" по 2 сторінки на листі", vbExclamation+vbOKCancel, _
"Перший прохід друку")
if i = vbCancel Then Exit Sub
' друк одної сторони листів
Application.PrintOut FileName:="",Range:=wdPrintRangeOfPages,Item:=_
wdPrintDocumentContent, Copies:=1, Pages:=s, PageType:= _ wdPrintAllPages,ManualDuplexPrint:=False,Collate:=True,Background:=_
True, PrintToFile:=False, PrintZoomColumn:=2, PrintZoomRow:=1, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
Else
'другий прохід друку
For i = 2 To n / 2 Step 2
s = s + Str(i) + "," + Str(n - i + 1) + ","
Next
s = Left(s, Len(s) - 1)
i=MsgBox ("Закладіть у прінтер " + Str(n / 4) + _
" листів оберненою стороною для друку сторінок з номерами " _
+ s + " по 2 сторінки на листі", _
vbExclamation+vbOKCancel, "Другий прохід друку")
if i = vbCancel Then Exit Sub
' друк оберненої сторони листів
Application.PrintOut FileName:="",Range:=wdPrintRangeOfPages,Item:=_
wdPrintDocumentContent, Copies:=1, Pages:=s, PageType:= _ wdPrintAllPages,ManualDuplexPrint:=False,Collate:=True,Background:=_
True, PrintToFile:=False, PrintZoomColumn:=2, PrintZoomRow:=1, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
End If
End Sub
Нижче наведено вікна-повідомлення, які виводяться макросом ДрукПосібника() при друці даного посібниками об’ємом 120с.
Задача. Створити макрос Word, який дозволяє змінювати шрифт абзаців в активному документі. Використати форму користувача.
‘ запуск макросу
Sub ФорматуванняАбзаців()
‘ виведення форми
UserForm1.Show
End Sub
Private Sub UserForm_Initialize() ‘ обробник події ініціалізації форми
Dim i As Byte
‘ заповнення комбінованих списків назвами шрифтів
With cmbNameNew
.AddItem ("Times New Roman")
.AddItem ("Arial")
.AddItem ("Tahoma")
.AddItem ("Verdana")
.AddItem ("Microsoft Sans Serif")
.ListIndex = 0
End With
With cmbNameOld
.AddItem ("Times New Roman")
.AddItem ("Arial")
.AddItem ("Tahoma")
.AddItem ("Verdana")
.AddItem ("Microsoft Sans Serif")
.ListIndex = 0
End With
‘ заповнення комбінованих списків розмірами шрифтів
For i = 6 To 26
cmbSizeOld.AddItem (Str(i)): cmbSizeNew.AddItem (Str(i))
Next
cmbSizeOld.ListIndex = 4: cmbSizeNew.ListIndex = 4
End Sub
‘ обробник події натискання командної кнопки
Private Sub cmdChange_Click()
Dim MyObject
Dim flag As Boolean
‘ визначення об’єкта виділення Selection в залежності від обраної
‘ радіокнопки
If optAll.Value = True Then Selection.WholeStory
If optCursor.Value = True Then ActiveDocument.Range_
(, End:=ActiveDocument.Content.End).Select
For Each MyObject In Selection.Paragraphs ' для кожного абзацу
With MyObject.Range
‘ умова співпадання параметрів поточного абзацу із введеними
‘початковими параметрами
If .Font.Size = Val(cmbSizeOld) And .Font.Name = cmbNameOld Then
.Font.Size = Val(cmbSizeNew)
.Font.Name = cmbNameNew
End If
End With
Next
End Sub
Задача. Створити макрос Excel, за допомогою якого кожен стовпчик з парним номером робиться прихованим.
Sub HideColumns( )
Set diap=Worksheets(“sheet1”).UsedRange
For Each col In diap.Columns
If col.Columns Mod 2=0 Then Col.Hidden=True
Next col
End Sub