|
[1] [2]
- Как отключить обновление экрана?
17.04.2012
- Как принудительно обновить экран в Word'е ?
17.04.2012
- Как программно "назначить" клавишам свой
собственный макрос ? (горячие клавиши для макроса) 17.04.2012
- Как программно определить нажата ли клавиша
CAPS LOCK и NUM LOCK ? 17.04.2012
- Как программно сменить раскладку клавиатуры ?
25.11.2014
- Как программно отключить вывод предупреждающего
сообщения о наличии макросах в Word 97 ? 18.04.2012
- Как определить удалён или нет об'ект, который
был создан программно ? 19.04.2012
- Как определить версию приложения ? 19.04.2012
- Как изменить внешний вид курсора мышки ?
19.04.2012
- Как с помощью Word'их функций вычислить
сумму, количество, а также среднее, минимальное и максимальное
значение - выделенных ячеек таблицы ? 21.04.2012
- Как в Word'е можно сохранить необходимые данные
(в т.ч. и значения переменных) даже после закрытия документа ?
26.04.2014
- Как открыть документ так, чтобы он был невидим
на экране ? 13.11.2014
- Как проверить открыт ли документ ?
NEW 03.08.2016
- Как импортировать всю графику из папки в
новый документ ? NEW 30.11.2015
- Как проверить запущено ли нужное приложение,
например, Excel или Калькулятор ?
NEW 06.07.2016
- Как получить список главных окон всех
запущенных приложений ? NEW 07.07.2016
[1] [2]
Ответ :
Для того, чтобы в Word/Excel отключить обновление экрана,
достаточно использовать свойство ScreenUpdating , т.е.
Application.ScreenUpdating = False
'Здесь должен быть код Вашей программы.
Application.ScreenUpdating = True |
причём в Word, в отличии от Excel, допустим и такой вариант :
| ScreenUpdating = False
'Здесь должен быть код Вашей программы.
ScreenUpdating = True |
Ответ :
Если на время выполнения макроса, Вы отключаете обновление
экрана (см. выше), но у Вас возникла необходимость
в принудительном обновлении экрана, то используйте метод
ScreenRefresh об'екта Application , т.е.
Application.ScreenRefresh |
Ответ :
Для того, чтобы в Word'е программно "назначить" клавишам свой
собственный макрос, можно использовать нижеопубликованный вариант,
разумеется, указав имя своего макроса, а также коды необходимых клавиш.
Предположим, что в неком документе, в стандартном модуле,
существует макрос HotKeyMacro и нам необходимо, чтобы после открытия
этого документа, нажатие клавиш CTRL + R приводило к его вызову, а
после закрытия, всё возвращалось на круги своя, то откройте этот документ,
скопируйте в стандартный модуль весь нижеопубликованный код, а затем,
сохраните изменения.
Public Sub AutoOpen()
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyR), KeyCategory:=wdKeyCategoryMacro, Command:="HotKeyMacro"
End Sub
Public Sub AutoClose()
KeyBindings.Key(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyR)).Clear
End Sub
Public Sub HotKeyMacro()
MsgBox "Это просто тест", vbInformation
End Sub |
или так :
| Sub AutoOpen()
KeyBindings.Add wdKeyCategoryMacro, "HotKeyMacro", (wdKeyControl + wdKeyR)
End Sub
Sub AutoClose()
KeyBindings.Key(wdKeyControl + wdKeyR).Clear
End Sub
Sub HotKeyMacro()
MsgBox "Это просто тест2", vbInformation
End Sub |
Ответ :
Для того, чтобы с помощью VBA, определить нажата ли клавиша
CAPS LOCK и NUM LOCK можно использовать свойства CapsLock
и NumLock об'екта Application
If Application.CapsLock = True Then
MsgBox "Клавиша CAPS LOCK нажата"
Else
MsgBox "Клавиша не нажата"
End If |
| If Application.NumLock = True Then
MsgBox "Клавиша NUM LOCK нажата"
Else
MsgBox "Клавиша не нажата"
End If |
Ответ :
Для того, чтобы с помощью VBA, сменить раскладку клавиатуры,
достаточно воспользоваться методом Keyboard об'екта
Application и указать ID необходимого языка, например :
Application.Keyboard wdRussian
Application.Keyboard wdEnglishUS |
Если же Вам потребуется определить текущую раскладку, только
для Русск. и Английск., то :
| If (Application.Keyboard And wdRussian) = wdRussian Then
MsgBox "RU"
Else
MsgBox "EN"
End If |
Для других языков, разумеется необходимо указать их константы,
полный перечень которых Вам предоставит Word.WdLanguageID
Ответ :
Актуально для MS Word 97
Для того, чтобы в Word 97 отключить вывод предупреждающего
сообщения о наличии макросах, достаточно в меню Сервис выбрать
команду Параметры, выделить закладку Общие и снять "флажок"
Защита от вирусов в макросах.
Если тоже самое нужно осуществить с помощью VBA, то :
Options.VirusProtection = False |
Ответ :
Для того, чтобы определить был ли удалён об'ект (вручную
или программно), созданный с помощью VBA, достаточно использовать
свойство IsObjectValid
Public objTable As Word.Table
Public Sub CreateWordObject()
Set objTable = ThisDocument.Tables.Add(Range:= _
ThisDocument.Sections.Add.Range, NumRows:=10, NumColumns:=3)
objTable.Select 'исключительно для примера
'objTable.Delete
End Sub |
Предположим, что после создания таблицы (см. макрос
CreateWordObject ), эта таблица могла быть удалена
(вручную или программно) и нам необходимо проверить существует
этот об'ект или нет :
| Public Sub IsWordObjectValid()
If IsObjectValid(objTable) = True Then
MsgBox "Об'ект существует", vbInformation
Else
MsgBox "Об'ект удалён", vbCritical
End If
End Sub |
Комментарий : В данном примере, таблица, разумеется,
используется только в демонстрационных целях.
Ответ :
Для того, чтобы в Word/Excel определить версию приложения,
достаточно использовать свойство Version
об'екта Application
Select Case Val(Application.Version)
Case 8: iVersion = "97"
Case 9: iVersion = "2000"
Case 10: iVersion = "XP"
Case 11: iVersion = "2003"
Case 12: iVersion = "2007"
Case 14: iVersion = "2010"
Case 15: iVersion = "2013"
Case Else: iVersion = "Неизвестно ..."
End Select
MsgBox "Работа идёт в Microsoft Word " & iVersion |
| Dim iVersion As Variant
iVersion = Choose(Val(Application.Version) - 7, "97", "2000", "XP", "2003", "2007", "2010", "2013")
If Not IsNull(iVersion) Then
MsgBox "Работа идёт в Microsoft Word " & iVersion
Else
MsgBox "Неизвестная науке версия Word"
End If |
Ответ :
Для того, чтобы в Word'е изменить курсор мышки, можно
использовать свойство Cursor об'екта System
System.Cursor = wdCursorWait 'wdCursorNorthWestArrow 'wdCursorIBeam
For iCount = 1 To 100000
StatusBar = "Счётчик " & iCount
'Application.StatusBar = "Счётчик " & iCount
Next
'System.Cursor = wdCursorNormal 'по умолчанию |
Ответ :
Для того, чтобы с помощью Word'их функций вычислить сумму,
количество чисел, а также среднее, минимальное и максимальное значение -
выделенных ячеек таблицы, можно использовать следующий код, разумеется,
предварительно выделив нужные ячейки таблицы (или всю таблицу целиком)
Public Sub CreateInformationInTable()
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Dim objBookmark As Word.Bookmark
Dim objTable As Word.Table, iAddress$
Set objSel = Selection 'Application.Selection
If objSel.Information(wdWithInTable) = True Then
Application.ScreenUpdating = False
Set objDoc = ActiveDocument
Set objBookmark = objDoc.Bookmarks.Add("ТаблицаX", objSel)
Set objTable = objDoc.Tables.Add(objDoc.Sections.Add.Range, 5, 2)
iAddress = "ТаблицаX " & getTableAddress(objSel)
objTable.Cell(1, 1).Range.Text = "Сумма :"
objTable.Cell(1, 2).Formula "=SUM(" & iAddress & ")"
objTable.Cell(2, 1).Range.Text = "Количество :"
objTable.Cell(2, 2).Formula "=COUNT(" & iAddress & ")"
objTable.Cell(3, 1).Range.Text = "Минимум :"
objTable.Cell(3, 2).Formula "=MIN(" & iAddress & ")"
objTable.Cell(4, 1).Range.Text = "Максимум :"
objTable.Cell(4, 2).Formula "=MAX(" & iAddress & ")"
objTable.Cell(5, 1).Range.Text = "Среднее :"
objTable.Cell(5, 2).Formula "=AVERAGE(" & iAddress & ")"
objBookmark.Delete: objTable.Select 'необязательно
Application.ScreenUpdating = True
Else
MsgBox "Выделите таблицу или часть таблицы ... но не более"
End If
End Sub
Private Function getTableAddress$(objSel As Word.Selection)
getTableAddress = Chr( _
objSel.Columns.First.Index + 64) & _
objSel.Rows.First.Index & ":" & Chr( _
objSel.Columns.Last.Index + 64) & _
objSel.Rows.Last.Index
End Function |
Комментарий :
Обратите внимание на то, что все функции игнорируют
"числа", начинающиеся со знака + , например, +123
Если существует вероятность, что Ваша таблица может
насчитывать более 26 столбцов, то функцию
getTableAddress необходимо немного подкорректировать.
Ответ :
Если Вам необходимо хранить некие данные (в т.ч. это могут
быть значения переменных) в течении жизни всего документа, и при
этом, нужно избегать их непосредственного ввода в "тело" документа,
то в таком случае можно воспользоваться коллекцией
Variables об'екта Document
Private Sub SetTimeOpenDoc() 'Создание
ThisDocument.Variables.Add Name:="Время открытия", Value:=Time
End Sub
Private Sub GetTimeOpenDoc() 'Изменение
MsgBox "Сей документ открыли в : " & ThisDocument.Variables("Время открытия")
End Sub
Private Sub DeleteTimeOpenDoc() 'Удаление
ThisDocument.Variables("Время открытия").Delete
End Sub |
Комментарий :
SetTimeOpenDoc - имя переменной должно быть
уникально, т.к. в противном случае, Вы получите ошибку (в чём, кстати,
можно воочию убедиться, если попытаться повторно выполнить этот
макрос) и которую можно избежать, если перед применением метода
Add , проверить нет ли в коллекции переменной с таким именем.
GetTimeOpenDoc, DeleteTimeOpenDoc - переменная
с указанным именем должна существовать, ибо иначе Вы получите ошибку.
Как видите, при работе с коллекцией Variables неплохо
иметь "инструмент", позволяющий определять наличие/отсутствие нужной
переменной. К сожалению, разработчики Word'а не предоставили нам такой
возможности(метода), однако Вы можете воспользоваться нижеопубликованной
функцией VariableIsExist , которую лучше всего разместить
в стандартном модуле шаблона Normal.dot.
Public Function VariableIsExist( _
iVarName$, Optional objDoc As Word.Document) As Boolean
'**********************************************************************'
' Дата создания 25/04/2014
' Автор Климов Павел Юрьевич
' http://www.msoffice.nm.ru
'**********************************************************************'
If objDoc Is Nothing Then Set objDoc = ActiveDocument
Dim objVariable As Word.Variable
For Each objVariable In objDoc.Variables
If StrComp(objVariable.Name, iVarName$, vbTextCompare) = 0 Then
VariableIsExist = True
Exit Function
End If
Next
VariableIsExist = False
End Function |
Затем, по мере необходимости, просто вызывать эту функцию, следующим образом
(см. код Test_VariableIsExist)
указав [1] обязательный аргумент - имя искомой переменной
(регистр не важен), [2] необязательный - ссылка на документ ( можно не
использовать, если поиск необходимо осуществить в активном документе, т.е.
в ActiveDocument )
| Private Sub Test_VariableIsExist()
Dim objDoc As Word.Document, iVarName$
Set objDoc = ThisDocument: iVarName = "Время запуска"
If Not Normal.VariableIsExist(iVarName, objDoc) Then
objDoc.Variables.Add iVarName, Time
Else
objDoc.Variables(iVarName).Value = Time
'objDoc.Variables(iVarName).Delete
End If
End Sub |
Ответ :
Если Вам необходимо открыть существующий документ, причём так,
чтобы, во время работы макроса, он не мелькал перед глазами пользователя,
проще говоря, был невидим на экране, то Вы можете использовать любой из
нескольких нижеопубликованных вариантов.
Private Sub OpenUnvisibleDocument()
Dim iFileName$, objDoc As Word.Document
iFileName = "C:\Имя_документа.doc"
Set objDoc = GetObject(iFileName) ', "Word.Document")
'Здесь Вы можете работать с невидимым (на экране) документом
objDoc.Close saveChanges:=wdSaveChanges
'wdDoNotSaveChanges - закрыть без изменений
End Sub |
| Private Sub OpenUnvisibleDocument2() 'Word 2000(и старше)
Dim iFileName$, objDoc As Word.Document
iFileName = "C:\Имя_документа.doc"
Set objDoc = Documents.Open(FileName:=iFileName, Visible:=False)
'Здесь Вы можете работать с невидимым (на экране) документом
objDoc.Close saveChanges:=wdSaveChanges
'wdDoNotSaveChanges - закрыть без изменений
End Sub |
| Private Sub OpenUnvisibleDocument3()
Dim iFileName$: iFileName = "C:\Имя_документа.doc"
Application.ScreenUpdating = False
With Documents.Open(FileName:=iFileName)
'Здесь Вы можете работать с этим доком
.Close saveChanges:=wdDoNotSaveChanges
'wdSaveChanges сохранить все изменения
End With
Application.ScreenUpdating = True
End Sub |
Ответ :
Если существует вероятность, что на компьютере может быть
запущено несколько приложений Word и Вам необходимо узнать открыт
ли вполне определённый документ, то для этого можно использовать
функцию FileLocked из нижеприведённой статьи :
WD2000: VBA Function to Check Whether File or Document Is Open
Комментарий : Если эта проверка нужна только для того,
чтобы не пытаться открыть уже открытый документ, то можно сразу
(т.е. без проверки) использовать самый первый вариант из предыдущего
совета.
Ответ :
Если Вам необходимо импортировать всю графику из конкретной папки
в новый документ, то Вы можете использовать следующий вариант. Важно :
если в папке, кроме графических файлов могут присутствовать и другие, то
раскомментируйте (удалите апостроф) в строке 'On Error Resume Next
Private Sub ImportGraphicOutFolder()
Dim iPath$, iFileName$
Dim objDoc As Word.Document, objAnchor As Word.Range
iPath = "C:\Pictures\" 'Укажите свою папку с завершающим слэшем
iFileName = Dir(iPath)
If iFileName <> "" Then
'On Error Resume Next
Set objDoc = Documents.Add: Set objAnchor = objDoc.Range(0)
Do
objDoc.InlineShapes.AddPicture iPath & iFileName, False, True, objAnchor
Set objAnchor = objDoc.Range(objDoc.Range.End - 1)
iFileName = Dir
Loop Until iFileName = ""
'Kill iPath & "*"
Else
MsgBox "Импорт невозможен", vbCritical, ""
End If
End Sub |
Ответ :
Для того, чтобы определить запущено или нет нужное приложение,
можно воспользоваться об'ектом Tasks и его методом
Exists . Пример, для Microsoft Excel прилагается :
Private Sub FindWindowCaption()
If Not Tasks.Exists("Microsoft Excel") Then
Shell "Excel.exe", vbNormalFocus
Else
With Tasks("Microsoft Excel")
.Activate
.WindowState = wdWindowStateMaximize
End With
End If
End Sub |
Комментарий : На самом деле, в этом примере осуществляется
поиск окна, где в заголовке присутствует текст "Microsoft Excel",
поэтому, если этот текст будет изменён (а это возможно), то
приложение будет запущено повторно. Чтобы этого не происходило,
используйте более надёжный способ.
| Private Sub ExampleRunExcel()
On Error Resume Next
Dim objXL As Object
Set objXL = GetObject(, "Excel.Application")
If objXL Is Nothing Then
Shell "Excel.exe", vbNormalFocus
Else
objXL.WindowState = -4137 'xlMaximized
AppActivate objXL.Caption
End If
End Sub |
Для поиска запущенного калькулятора также можно использовать
вышеупомянутый об'ект, только не забывайте, что текст на
кириллице, а именно Калькулятор - это только для
руссифицированной OC.
| Private Sub FindWindowCaption2()
If Not Tasks.Exists("Калькулятор") Then
Shell "Calc.exe", vbNormalFocus
Else
Tasks("Калькулятор").Activate
End If
End Sub |
И напоследок, поиск всех текстовых файлов, открытых в Блокноте
с последующим их сохранением и закрытием.
| Private Sub FindOpenTextFileAndClose()
Dim objTask As Word.Task
For Each objTask In Tasks
If InStr(objTask.Name, "Блокнот") > 0 Then
objTask.SendWindowMessage 273&, 3&, 0&
objTask.Close
End If
Next
End Sub |
Второй вариант также позволяет осуществить задуманное, причём,
без обязательной руссификации OC, однако, он будет игнорировать
все файлы не имеющие расширения .txt , в т.ч. .ini и .log , хотя
это тоже текстовые файлы.
| Private Sub FindOpenTextFileAndClose2()
Dim objTask As Word.Task
For Each objTask In Tasks
If LCase(objTask.Name) Like "*.txt*" Then
objTask.SendWindowMessage 273&, 3&, 0&
objTask.Close
End If
Next
End Sub |
Ответ :
Private Sub CreateListTasks()
Dim objAnchor As Word.Range
Dim objTask As Word.Task, iRow%: iRow = 1
Set objAnchor = Documents.Add.Range
With objAnchor.Tables.Add(objAnchor, Tasks.Count + 1, 3, wdWord9TableBehavior)
'.Style = wdStyleTableColorfulList 'Word 2007
.Rows(iRow).Range.Bold = True
.Cell(iRow, 1).Range = "#"
.Cell(iRow, 2).Range = "Task Name"
.Cell(iRow, 3).Range = "Visible"
For Each objTask In Tasks
iRow = iRow + 1
.Cell(iRow, 1).Range = iRow - 1
.Cell(iRow, 2).Range = objTask.Name
.Cell(iRow, 3).Range = objTask.Visible
Next
.Columns.AutoFit
End With
End Sub |
| | | | | | | | | | | | | | | | |
|