Улучшенный макрос для вставки формул с нумерацией

Следуя замечанию Иероглиф, я изменил первый вариант макроса. К сожалению, полностью избавиться от Selection невозоможно, потому что нужен метод InsertStyleSeparator.

Копировать код без номеров строк

1 Sub NumberEquation()
2 '
3 'Вставка формулы с нумерацией.
4 '
5 Dim oRng As Range
6 Set oRng = Selection.Range
7 With oRng.ParagraphFormat
8 .SpaceAfterAuto = False: .SpaceBeforeAuto = False
9 .FirstLineIndent = 0
10 .TabStops.ClearAll
11 .TabStops.Add (oRng.Sections(1).PageSetup.PageWidth - oRng.Sections(1).PageSetup.LeftMargin - oRng.Sections(1).PageSetup.RightMargin - .LeftIndent - .RightIndent) / 2, _
12 wdAlignTabCenter, wdTabLeaderSpaces
13 .TabStops.Add oRng.Sections(1).PageSetup.PageWidth - oRng.Sections(1).PageSetup.LeftMargin - oRng.Sections(1).PageSetup.RightMargin - .LeftIndent - .RightIndent, _
14 wdAlignTabRight, wdTabLeaderSpaces
15 End With
16 With oRng
17 .InsertBefore vbTab
18 .Collapse wdCollapseEnd
19 .InsertParagraphAfter
20 .Select
21 With Selection
22 .InsertStyleSeparator
23 .TypeText vbTab & "("
24 .Fields.Add .Range, wdFieldSequence, "formula", True
25 .TypeText ")"
26 End With
27 .InlineShapes.AddOLEObject "Equation.3", , False
28 .InlineShapes(1).Select
29 End With
30 End Sub

Динамическое создание пользовательской формы

Иногда возникает необходимость создать форму не вручную, используя встроенный редактор, а программно, в зависимости от внешних условий. К счастью, VBA предоставляет и такую возможность. Здесь я приведу пример как можно создать форму, поместить на нее заданное количество текстовых полей и кнопку. А также указать обработчики событий для каждого элемента.
Основная идея состоит в том, что сначала нужно программно добавить в проект форму, затем на эту форму добавить компоненты, и связать компоненты с событиями. Нам придется создать в проекте три модуля: обычный программный модуль и два модуля класса. В одном модуле класса мы определим коллекции, в которые будем добавлять компоненты по мере их добавления на форму. Второй класс будет отвечать за события, происходящие с нашими компонентами.

Копировать код без номеров строк

1 Option Explicit
2 Dim COF As ControlsOnForm, EOC As EventsOfControls
3
4 Sub CreateForm(NumberOfTextBoxes As Integer)
5 'Добавляем пустую форму и код процедуры, которая выполняется при запуске формы
6 Dim oNewForm 'Новая форма
7 Dim sCode 'Переменная для хранения кода формы
8 ' Application.VBE.MainWindow.Visible = False
9 'Создаем форму
10 Set oNewForm = ThisDocument.VBProject.VBComponents.Add(3) 'vbext_ct_MSForm
11 'Добавляем конструкторы классов для событий формы
12 sCode = ""
13 'Создаем процедуру инициализации формы
14 sCode = sCode & "Sub UserForm_Initialize()" & vbCrLf
15 sCode = sCode & vbTab & "GetControlsForForm Me, " & NumberOfTextBoxes & vbCrLf
16 ' sCode = sCode & vbTab & "UpdateControls" & vbCrLf
17 sCode = sCode & "End Sub" & vbCrLf
18 'Вставляем код формы
19 oNewForm.CodeModule.InsertLines oNewForm.CodeModule.CountOfLines + 1, sCode
20 'Показываем форму
21 VBA.UserForms.Add(oNewForm.Name).Show
22 'Удаляем форму из рабочей книги
23 ThisDocument.VBProject.VBComponents.Remove oNewForm
24
25 End Sub
26 'Процедура, создающая указанное количество текстовых полей на указанной форме, и кнопку
27 Sub GetControlsForForm(ByVal oForm As Object, ByVal NumberOfTextBoxes As Integer)
28 'Переменные для объектов на форме
29 Dim oBtn As MSForms.CommandButton
30 Dim oTxt As MSForms.TextBox
31 'Верхний левый угол компонента
32 Dim iLeft As Integer, iTop As Integer
33 'Счетчик
34 Dim i As Integer
35 'Максимальный размер формы
36 Dim iMaxWidth As Integer, iMaxHeight As Integer
37
38 'Заполняем форму компонентами
39 Set COF = New ControlsOnForm
40 iLeft = 6: iTop = 6 'Верхний левый угол первого текстового поля
41 For i = 1 To NumberOfTextBoxes
42 'Создаем кнопку
43 Set oTxt = oForm.Controls.Add("Forms.TextBox.1", "txtNumber" & i)
44 With oTxt
45 .Text = .Name
46 .Left = iLeft: .Top = iTop
47 iTop = iTop + .Height
48 iMaxWidth = iLeft + .Width + 6
49 iMaxHeight = iTop - .Height + 20
50 End With
51 'Связываем текстовое поле с обработчиком событий
52 Set EOC = New EventsOfControls: Set EOC.TextBoxEv = oTxt
53 'Добавляем в коллекцию
54 COF.TextBoxes.Add EOC
55 Next i
56 'Теперь добавляем кнопку
57 Set oBtn = oForm.Controls.Add("Forms.CommandButton.1", "btnTest")
58 With oBtn
59 .Caption = "Моя кнопка"
60 .Left = iLeft
61 .Top = iTop
62 iMaxWidth = iLeft + .Width + 6
63 iMaxHeight = iTop + .Height + 20
64 End With
65 'Связываем кнопку с обработчиком событий
66 Set EOC = New EventsOfControls: Set EOC.ButtonEv = oBtn
67 'Добавляем в коллекцию
68 COF.Buttons.Add EOC
69 'Подгоняем размеры формы
70 oForm.Height = iMaxHeight: oForm.Width = iMaxWidth
71 End Sub
72
73 'Основная процедура, запускающая весь процесс
74 Sub СоздатьФорму()
75 Dim TBCount As Integer
76 Dim sInput As String
77 Do
78 sInput = InputBox("Введите число нужных текстовых полей", "Динамическое создание формы", 5)
79 If Len(sInput) = 0 Then Exit Sub 'Если ничего не ввели, или нажали отмену
80 'Если ввели не число, предлагаем ввод еще раз
81 If IsNumeric(sInput) Then TBCount = CInt(sInput) Else sInput = ""
82 Loop Until Len(sInput) > 0
83 CreateForm (TBCount)
84 End Sub

Думаю, что дополнительные комментарии излишни. После отработки кода на экране появится форма, но в документе ее уже не будет, потому что она удаляется из документа после показа.

Копировать код без номеров строк

1 Option Explicit
2 'Класс, для хранения в коллекциях элементов формы
3 Public Buttons As New Collection
4 Public TextBoxes As New Collection

Копировать код без номеров строк

1 Option Explicit
2 'Этот класс содержит в себе обработчики событий для различных элементов формы
3 'Элемент, ответсвтвенный за обработку событий в текстовом поле
4 Public WithEvents TextBoxEv As MSForms.TextBox
5 'Обработчик событий кнопки
6 Public WithEvents ButtonEv As MSForms.CommandButton
7
8 Private Sub ButtonEv_Click()
9 Dim oForm As Object
10 Set oForm = Me.ButtonEv.Parent
11 MsgBox "Вы кликнули на кнопке " & Me.ButtonEv.Name & vbCr & _
12 "На форме расположено " & Me.ButtonEv.Parent.Controls.Count - 1 & " текстовых полей", vbInformation, _
13 "Динамическое создание формы"
14 End Sub
15 'Обработчик двойного нажатия в текстовом поле
16 Private Sub TextBoxEv_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
17 MsgBox "Вы дважды кликнули мышкой в текстовом поле " & Me.TextBoxEv.Name & "!", vbInformation, _
18 "Динамическое создание формы"
19 End Sub

Здесь можно описать любые события, доступные для того или иного компонента. Это очень удобно.
Подобным образом можно создавать довольно сложные формы. Например, такую форму, которая автоматически генерировалась на основе документа Word, в котором содержались экзаменационные вопросы по информатике для слушателей курсов. Документ Word был специальным образом отформатирован. Пользователь последовательно проходил по вопросам, ставя галочки на правильных ответах. На последнем вопросе активировалась кнопка «Готово» и программа считала результат теста.

Объект Range и работа с ним.

Последнее время я часто сталкиваюсь с его использованием. На изученных мною ресурсах, посвященных VBA для Word, почему-то мало внимания уделяется такому важному представителю объектной модели. С его помощью можно, поистине, творить чудеса с документом.
Этот объект гораздо удобнее Selection, потому что позволяет не выделять нужную область на экране, а работать прямо с представлением документа в памяти. Это заметно ускоряет работу макросов, которые, по правде сказать, не отличаются быстродействием. При отладке программ бывает полезно воспользоваться методом Range.Select, чтобы убедиться, что вы работаете с нужным вам диапазоном.
Что же это за объект? Сразу хочу предупредить, что писать я буду, основываясь на своем понимании найденного и прочитанного в других источниках. В дословном переводе Range означает «Диапазон». Применительно к Word  — это означает диапазон свойств или методов, доступных для того или иного объекта. Например, как узнать текст второго абзаца в документе? Вот так:

    1 
ActiveDocument.Paragraphs(2).Range.Text

Стоит отметить, что это вернет весь текст в абзаце с символом конца абзаца (¶). Его можно удалить функцией Replace заменив символ vbCr на пустую строку.
Но главная фишка объекта Range совсем не в этом. А в том, что его можно передвигать и изменять в размерах практически произвольно (в пределах документа, естественно). У каждого объекта Range есть два свойства: Range.Start и Range.End. Начальный и конечный символ диапазона, считая от начала документа. Начало и конец диапазона можно задавать, указывая эти свойства напрямую, а можно такой конструкцией:

    1 
    2 
Dim oRng As Range
 Set oRng = ActiveDocument.Range(20, 50)

Изменить размер уже существующего диапазона можно с помощью метода SetRange, в котором указать номер символа, с которого диапазон начинается, и каким заканчивается. Этот метод используется тогда, когда нужно изменить уже существующий диапазон. Этот метод ничего не возвращает, а работает со своим родительским объектом

    1 
    2 
    3 
Dim oRng As Range
 Set oRng = ActiveDocument.Range
 oRng.SetRange 20, 50

С помощью Range можно получить такие объекты документа, для которых не предусмотрено коллекций, как, например, для абзацев (коллекция Paragraphs). Такими «бесхозными» объектами являются строки и страницы. Кто знает другие, пусть напишет.
Как получить страницу из документа со всем ее содержимым? Коллекции Pages не существует, что же делать? Вот здесь и понадобится Range и его метод GoTo

    1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
Sub TestGoTo()
  Dim oRng As Range
  'Даем в переменную oRng начало третьей страницы в документе.
  Set oRng = ThisDocument.Range.GoTo(wdGoToPage, wdGoToNext, , "3")
  MsgBox "Третья страница начинается с " & oRng.Start & " символа.", 64, "Метод GoTo"
  'Расширяем диапазон oRng на всю третью страницу
  Set oRng = ThisDocument.Range(oRng.Start, oRng.GoToNext(wdGoToPage).Start)
  MsgBox "На третьей странице находится " & oRng.Paragraphs.Count & " абзацев.", 64, "Метод GoTo"
  'Берем 10 строку с третьей страницы
  Set oRng = oRng.GoTo(wdGoToLine, wdGoToNext, 10)
  Set oRng = ThisDocument.Range(oRng.Start, oRng.GoToNext(wdGoToLine).Start)
  MsgBox "В десятой строке третьей страницы содержится " & oRng.Characters.Count & " символов.", 64, "Метод GoTo"
End Sub

Таким образом можно, например, сохранить каждую страницу документа в файл. На одном форуме я выкладывал пример такого макроса, нашлись даже добровольцы, которые довели его почти до совершенства.

Вставка картинок в документ.

Тривиальная, казалось бы, задача. Но иногда возникает необходимость вставить в документ картинку, а подписью сделать имя файла этой картинки. Конечно, можно это делать вручную. Но очень неудобно. Тем более, если картинка не одна.
Вот как эту задачу можно решить с помощью макроса.

    1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 
Sub ДобавлениеКартинок()
  Dim oPicture As InlineShape
  Dim sFileName As String, sFileNameShort As String
'***********************************************************************************
  With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = False
    .ButtonName = "Вставить": .InitialView = msoFileDialogViewPreview: .Title = "Вставить картинку с названием"
    .Filters.Clear: .Filters.Add "Изображения", "*.jpg;*.jpeg;*.gif;*.png;*.bmp": .Filters.Add "Все файлы", "*.*"
    If .Show Then sFileName = .SelectedItems(1) Else Exit Sub
  End With
  sFileNameShort = CreateObject("Scripting.FileSystemObject").GetFile(sFileName).ShortName
  sFileNameShort = Mid(sFileNameShort, 1, InStrRev(sFileNameShort, ".") - 1)
  Set oPicture = ActiveDocument.InlineShapes.AddPicture(sFileName, False, True, Selection.Range)
  oPicture.Select: Selection.InsertCaption "Рисунок", " " & sFileNameShort
End Sub

Как работает? Пользователю дают выбрать файл. Затем этот файл вставляется как картинка в документ и к картинке добавляется автоназвание. Вот и все. Просто и эффективно.

Кризис, однако…

В связи с кризисом остается мало времени на обновление данных для блога. Хотя есть чем поделиться. Например, методы работы с классами и коллекциями. Очень полезная штука. А также тонкости работы с графическими объектами в Word (как оказалось они требуют очень бережного отношения).
Сегодня кратко

Копировать код без номеров строк

1 With Application.FileDialog(msoFileDialogFolderPicker)
2 .AllowMultiSelect = False
3 .Title = "Выберите папку с фотографиями"
4 If .Show <> 0 Then
5 sPath = .SelectedItems(1) & "\"
6 Else: MsgBox "Вы не выбрали папку. Запустите макрос снова.": Exit Sub:
7 End If
8 End With

Копировать код без номеров строк

1 With Application.FileDialog(msoFileDialogFilePicker)
2 .AllowMultiSelect = False
3 If .Show <> 0 Then
4 dfile = .SelectedItems(1)
5 Workbooks.Open dfile
6 Else
7 MsgBox "Вы нажали «Отмена»"
8 End If
9 End With

Хочу поделиться некоторыми приемами, которые я использую при написании своих поделок на VBA. Приемы эти касаются даже не самой техники программирования, а стиля. Они позволяют сделать тексты программ более аккуратными, читаемыми и понятными.
Основные правила такие:

1. Объявлять все переменные, которые используются. Чтобы об этом помнить всегда, в настройках редактора VBA установите флажок «Require Variable Declaration». Тогда в начале каждого нового модуля будет вставляться строка Option Explicit. И если вы переменную не объявили, то будет выдано предупреждение.


2. Использовать понятные имена для функций, процедур, переменных и классов. однобуквенные переменные лучше всего использовать в циклах в качестве счетчиков. Если нет вложенных циклов, то одну переменную, традиционно это i. Если циклы вложенные, тогда i, j, k
и т.д.

3. Разбивать, при возможности, одну сложную процедуру или функцию на несколько простых.


4. Использовать отступы для форматирования кода.


5. Обязательно комментировать код, особенно если вы его передаете другому человеку.


6. И, наконец, личное: предварять имена функций, переменных и процедур одной буквой, которая указывает на тип данных, возвращаемых данным объектом. Например, iConfig
указывает, что эта переменная объявлена как Integer, или для функции sfCheck f означает, что это функция, а s, что она возвращает строку

Чтобы не мучаться с запоминанием какая буква, за какой тип отвечает, я использую операторы, которые по умолчанию указывают, что если объект начинается с этой буквы, то он такого-то типа.

Копировать код без номеров строк

1 DefBool B'для типа Boolean
2 DefDbl D' для типа Double
3 DefInt I'для типа Integer
4 DefLng L' для типа Long
5 DefObj O' для типа Object
6 DefStr S' для типа String
7 DefVar V' для типа Variant
8 'После этого можно объвить все переменные разных типов одной строкой
9 Dim iCounter, sMyString, oMyObject

Это не все операторы. Все можно узнать в справке по запросу «Deftype Statements»

Работа с макросами из макросов

Заголовок сообщения звучит несколько странно, но, как мне кажется, правильно.
Возникла у меня задача: создать динамическое меню, которое содержало бы в себе все доступные для выполнения макросы. Т.е. чтобы не открывать окно с макросами по Alt+F8, а иметь для этого дела меню, которое к тому же обновлялось автоматически, в зависимости от количества доступных макросов.
Кроме того, что нужно следить за формированием самого меню, которое рассматривается здесь, нужно решить такие задачи:

1. Определить загруженные шаблоны, макросы из которых доступны для выполнения.


2. Определить имена модулей, в которых содержится программный код макросов.


3. В каждом модуле найти собственно сами макросы.


4. Скомпоновать все это в меню.


5. Сделать, чтобы все это работало

Для работы с загруженными шаблонами используем свойство приложения Application.Templates. Чтобы определить, есть ли в шаблоне макросы пользуемся свойством VBProject, которое предоставляет некоторые инструменты для работы с содержимым шаблона.
Мной были разработаны некоторые функции:

• fGetModulesNames — функция, которая определяет имена модулей в конкретном шаблоне;


• fGetFuncNames — функция, которая определяет имена функций (макросов) в конкретном модуле конкретного шаблона;


• fGetFuncQuant — функция, которая определяет количество функций (макросов) в конкретном модуле конкретного шаблона;

    1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 
   16 
   17 
   18 
   19 
   20 
   21 
   22 
   23 
   24 
   25 
   26 
   27 
   28 
   29 
   30 
   31 
   32 
   33 
   34 
   35 
   36 
   37 
   38 
   39 
   40 
   41 
   42 
   43 
   44 
   45 
   46 
   47 
   48 
   49 
   50 
   51 
   52 
   53 
   54 
   55 
   56 
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66 
   67 
   68 
   69 
   70 
   71 
   72 
   73 
   74 
   75 
   76 
   77 
   78 
   79 
   80 
   81 
   82 
   83 
   84 
   85 
   86 
   87 
   88 
   89 
   90 
   91 
   92 
   93 
Public Function fGetFuncQuant(ByVal oCodeModuleName As VBComponent) As Long
'
'Функция определяет количество функций в указанном модуле.
'
  Dim nCounterOfProc, nEmptyCounter, i As Integer
  Dim sOld, sNew As String
'Если в указанном модуле есть более 1 строки
  If oCodeModuleName.codemodule.CountOfLines <> 0 Then
'Определяем номер строки, с которой считать строки кода
    Do
      nEmptyCounter = nEmptyCounter + 1
      sOld = oCodeModuleName.codemodule.ProcOfLine(nEmptyCounter, vbext_pk_Proc)
    Loop Until sOld <> ""
'Считаем процедуры в модуле, начиная со строки, номер которой определили выше
    For i = nEmptyCounter To oCodeModuleName.codemodule.CountOfLines
      If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
        sNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
        If sNew <> sOld Then
          sOld = sNew
          nCounterOfProc = nCounterOfProc + 1
        End If
      End If
    Next i
  End If
  fGetFuncQuant = nCounterOfProc
End Function

Public Function fGetFuncNames(ByVal oDocOrTemplName As Object, ByVal oCodeModuleName As VBComponent) As Variant
'
'Функция получает имена всех функций в модуле и записывает их в массив.
'
  Dim sProcNameNew, sProcNameOld As String
  Dim i, j, k As Integer
  Dim asFuncNames() As String 'массив для хранения имен функций в модуле
  ReDim asFuncNames(fGetFuncQuant(oCodeModuleName)) 'задаем размер массива
'Выбираем модуль документа или стандартный модуль с макросами.
'Также проверяем, чтобы в модуле были непустые строки
  If oCodeModuleName.Type = vbext_ct_StdModule _
      Or vbext_ct_Document _
      And oCodeModuleName.codemodule.CountOfLines <> 0 Then
    Do
      k = k + 1
      asFuncNames(0) = oCodeModuleName.codemodule.ProcOfLine(k, vbext_pk_Proc)
    Loop Until asFuncNames(0) <> ""
    For i = k To oCodeModuleName.codemodule.CountOfLines
      If oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc) <> "" Then
        sProcNameNew = oCodeModuleName.codemodule.ProcOfLine(i, vbext_pk_Proc)
        If sProcNameNew <> asFuncNames(j) Then
          asFuncNames(j + 1) = sProcNameNew
          j = j + 1
        End If
      End If
    Next i
    k = 0
  End If
  fGetFuncNames = asFuncNames
End Function

Public Function fGetModulesNames(ByVal oDocOrTemplName As Object) As Variant
'
'Процедура определяем имена модулей с макросами в документе или шаблоне и записываем их в массив.
'
  Dim oCodeModuleName As VBComponent
  Dim nCounterOfModules As Integer 'счетчик программных модулей
  Dim asModulesNames() As String 'массив для хранения имен модулей с макросами. После выполнения
'этот массив возвращается как результат функции.
'Определяем количество нужных нам модулей, чтобы затем правильно задать размер массива. Свойство
'«Count» компонента «VBProject» не используем, т.к. нужно определить только количество модулей
'определенного типа.
  For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
    If oCodeModuleName.Type <> vbext_ct_ClassModule _
      And vbext_ct_ActiveXDesigner _
      And vbext_ct_MSForm _
      And InStr(oCodeModuleName.Name, "NNN") = 0 _
      And oCodeModuleName.codemodule.CountOfLines <> 0 Then
      nCounterOfModules = nCounterOfModules + 1
    End If
  Next oCodeModuleName
  ReDim asModulesNames(nCounterOfModules - 1)
  nCounterOfModules = 0
'Записываем в массив имена модулей
  For Each oCodeModuleName In oDocOrTemplName.VBProject.VBComponents
    If oCodeModuleName.Type <> vbext_ct_ClassModule _
      And vbext_ct_ActiveXDesigner _
      And vbext_ct_MSForm _
      And InStr(oCodeModuleName.Name, "NNN") = 0 _
      And oCodeModuleName.codemodule.CountOfLines <> 0 Then
      asModulesNames(nCounterOfModules) = oCodeModuleName.Name
      nCounterOfModules = nCounterOfModules + 1
    End If
  Next oCodeModuleName
  fGetModulesNames = asModulesNames
End Function