VBA. Лабораторна робота 2




Каркас документа Word

Word - библиотека, задающая основу документов Word. Здесь хранится класс, задающий корневой объект Word.Application, и все классы объектов, вложенных в корневой объект.
Office - библиотека объектов, общих для всех приложений Office 2000. Здесь находятся классы, определяющие инструментальные панели - CommandBar и классы других общих объектов. Здесь же находятся классы, задающие Помощника (объект Assistant и все классы, связанные с ним). В частности, появился новый объект, которого не было в предыдущей версии - Мастер Ответов (Answer Wizard).
Stdole - библиотека классов, позволяющая работать с OLE - объектами и реализовать Автоматизацию.
VBA - библиотека классов, связанных с языком VBA. Здесь хранятся все стандартные функции и константы, встроенные в язык, классы Collection и ErrObject .
Project - проект по умолчанию, связанный с документом. Классы, которые могут программистом создаваться в этом проекте, методы, свойства, - все это доступно для просмотра, так же, как и объекты классов, встроенных в стандартные библиотеки.
Normal - проект, доступный для всех документов Word. Здесь могут храниться функции и классы, используемые всеми документами.

Объект Word.Application

Public Sub WorkWithBrowser()
'Работа с объектом Browser
Dim myrprev As Range, myrnext As Range, Answer As String
'Поиск нужного заголовка в диалоге с пользователем
'Установить заголовок в качестве цели поиска
Application.Browser.Target = wdBrowseHeading
With ActiveDocument
'Встать в начало документа
.Paragraphs.First.Range.Select
Set myrnext = Selection.Range
Do
Answer = InputBox("Это искомый заголовок? (Да/Нет)", "Заголовки", "Нет")
If Answer = "Да" Then Exit Do
'Передвинуться к следующему заголовку
Application.Browser.Next
Set myrprev = myrnext
Selection.MoveEnd (wdParagraph)
Set myrnext = Selection.Range
Loop Until (myrprev = myrnext)

If Answer = "Нет" Then
MsgBox ("В данном документе нет других заголовков стиля Heading")
End If
End With
End Sub
Public Sub WindowOpenFile()
'Предоставление пользователю возможности открыть любой файл.
'Открывается каталог, хранящий активный документ, с показом всех файлов.
Dim Act As Long
With Dialogs (wdDialogFileOpen)
.Name = ActiveDocument.Path & "\*.*"
Act = . Show
Debug.Print Act
If Act = -1 Then
'Файл успешно открыт и можно получить путь к нему и его имя
Debug.Print Documents(1).Path & "\" & Documents(1).Name
End If
End With
End Sub
Public Sub WorkWithOptions()
'работа с объектом Options
Options.AutoFormatAsYouTypeReplaceFractions = True
Options.AllowDragAndDrop = True
Options.CheckGrammarWithSpelling = True
Options.EnableSound = False
Options.MonthNames = wdMonthNamesEnglish
Options.PrintComments = True
End Sub
The Debug object sends output to the Immediate window at HYPERLINK "javascript:hhobj_7.Click()"run time.
Public Sub WorkWithSystem()
'Получение характеристик компьютера и окружения
Dim env As System
Set env = Application.System
'Debug.Print "Тип компьютера - ", env.ComputerType
Debug.Print "Тип процессора - ", env.ProcessorType
Debug.Print "Операционная система - ", env.OperatingSystem
Debug.Print "Язык - ", env.LanguageDesignation
Debug.Print "Свободного дискового пространства - ", env.FreeDiskSpace
Debug.Print "Курсор - ", env.Cursor
End Sub
Коллекции объекта Document
Рассмотрим список коллекций, входящих в состав объекта Document:
Bookmarks
Characters (Range)
CommandBars
Comments
DocumentProperties
Endnotes
Fields
Footnotes
FormFields
Frames
Hyperlinks
Indexes
InlineShapes
HorizontalLineFormat
ListParagraphs
Lists
ListParagraphs
Range
ListTemplates
ListLevels
Font
Paragraphs
ProofreadingErrors (Range)
Revisions
ReadabilityStatistics
Scripts
Sections
Sentences (Range)
Shapes
StoryRanges (Range
Styles
Subdocuments
Tables
TablesOfAuthoritiesCategories (TableOfAuthoritiesCategory)
TablesOfAuthorities (TableOfAuthorities)
TablesOfContents (TableOfContents)
TablesOfFigures (TableOfFigures)
Variables
Versions
Windows
Words (Range)
Автомакросы (Auto Macros) - это макросы со специально фиксированными именами. Они вызываются при возникновении ряда событий и являются альтернативным способом их обработки.
AutoExec - при запуске приложения Word;
AutoNew - при создании нового документа;
AutoOpen - при открытии существующего документа
AutoClose - при закрытии документа;
AutoExit - при выходе из приложения
Option Explicit
'Класс EventsOfApp
Public WithEvents AppEv As Word.Application
Private Sub AppEv_DocumentOpen(ByVal Doc As Document)
MsgBox ("Hi " & Doc.Name)
End Sub
Private Sub AppEv_DocumentChange()
Const Msg1 = "Вы переключились на работу с новым документом!"
Call MsgBox(Msg1 & vbCrLf & ActiveDocument.Name, vbInformation, "Окно информации!")
End Sub
Private Sub AppEv_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
MsgBox ("Вы закрываете документ " & Doc.Name)
DocQuit
End Sub

'Module:
Public App1 As New EventsOfApp
Public Sub OnEvents()
'Определение объекта Word.Application with Events
'Связывание
Set App1.AppEv = Word.Application
'Теперь начинают работать обработчики событий у Word.Application
End Sub
Public Sub DocQuit()
With ActiveDocument
If ExistVar("CounterDoc") Then
MsgBox "Число открытий документа " & .Name & vbCrLf & _
.Variables("CounterDoc"), VBE xclamation, "Число открытий документа!"
Else
MsgBox "У документа " & .Name _
& " нет счетчика числа открытий", VBE xclamation, "Число открытий документа!"
End If
End With
End Sub
Sub AutoOpen()
'Связывание объекта Application с событиями
Set App1.AppEv = Application
End Sub

Sub Macro1()
Dim size1 As Integer
Dim size2 As Integer
size1 = InputBox("First size:", "Enter sizes of two-dimension array", 5)
size2 = InputBox("Second size:", "Enter sizes of two-dimension array", 5)
'Dim myArray(1, 1) As Integer
ReDim myArray(1 To size1, 1 To size2) As Integer
Dim i, j
For i = 1 To size1 Step 1
For j = 1 To size2
myArray(i, j) = i + j
Next j
Next i
Dim msg As String
msg = "our array is" & vbCrLf
For i = 1 To size1 Step 1
For j = 1 To size2
msg = msg & " [" & i & "][" & j & "]=" & myArray(i, j)
Next j
msg = msg & vbCrLf
Next i
MsgBox msg
Options.ReplaceSelection = False
Selection.TypeText Text:=msg
End Sub







Sub Macro1()

Dim size1 As Integer
Dim size2 As Integer
size1 = InputBox(" Rozmir pershogo masuvy :", "Enter sizes of two-dimension array", 4)
size2 = InputBox("Rozmir drygogo masuvy:", "Enter sizes of two-dimension array", 4)
ReDim myArray(1 To size1, 1 To size2) As Integer
Dim i, j
For i = 1 To size1 Step 1
For j = 1 To size2
myArray(i, j) = InputBox("elemnet")
Next j
Next i
dim max as integer
max=-100000
For i = 1 To size1
For j = 1 To size2
if myArray(i, j) > max then
max = myArray(i, j)
end if
Next
Next

For i = 1 To size1
For j = 1 To size2
myArray(i, j) =3*myArray(i, j)/max
Next
Next

Dim msg As String
msg = "Rezyltat robotu programu" & vbCrLf
For i = 1 To size1 Step 1
For j = 1 To size2
msg = msg & " [" & i & "][" & j & "]=" & myArray(i, j)
Next j
msg = msg & vbCrLf
Next i
MsgBox msg
Options.ReplaceSelection = False
End Sub
Sub Macro1()

Dim size1 As Integer
Dim size2 As Integer
size1 = InputBox(" Rozmir pershogo masuvy :", "Enter sizes of two-dimension array", 4)
size2 = InputBox("Rozmir drygogo masuvy:", "Enter sizes of two-dimension array", 4)
Dim myArray(1 To size1, 1 To size2) As integer
Dim msg As String
Dim i, j
For i = 1 To size1 Step 1
For j = 1 To size2
myArray(i, j) = InputBox("elemnet")
Next j
Next i

msg = "po4atkovyj masyv" & vbCrLf
For i = 1 To size1 Step 1
For j = 1 To size2
msg = msg & " [" & i & "][" & j & "]=" & myArray(i, j)
Next j
msg = msg & vbCrLf
Next i
msg = msg & "Maksumalnuj element " & Max2(myArray())
msg = msg & "Rezyltat robotu programu " & vbCrLf
msg = msg & M1(myArray(), Max2(myArray()))
MsgBox msg
' msg = msg & "Novuj masuv " & myArray
End Sub
function M1(myArray() as Integer, max as integer) as string
For i = 1 To ubound(myArray, 1)
For j = 1 To ubound(myArray, 2)
myArray(i, j) = 3 * myArray(i, j) / max
Next
Next
dim msg as string

For i = 1 To ubound(myArray, 1)
For j = 1 To ubound(myArray, 2)
msg = msg & " [" & i & "][" & j & "]=" & myArray(i, j)
Next j
msg = msg & vbCrLf
Next i
M1=msg
end function
function Max2(myArray() as Integer) as integer
dim max as integer
dim i,j
max = -1

For i = 1 To ubound(myArray, 1)
For j = 1 To ubound(myArray, 2)
if myArray(i, j) > max then
max = myArray(i, j)
end if
Next
Next
Max2 = max
end function