Объявление переменных на уровне модуля
|
' Объявление переменных на уровне модуля Dim LeftW As Long, TopW As Long, HeightW As Long, WidthW As Long Dim StateW As WdWindowState Sub ChangeSizeWindow() With Application 'Запоминаем характеристики окна StateW = .WindowState LeftW = .Left TopW = .Top HeightW = .Height WidthW = .Width ' Изменяем характеристики окна .WindowState = wdWindowStateNormal .Left = 100 .Top = 100 .Height = 400 .Width = 400 End With End Sub Public Sub ResetSizeWindow() With Application ' Восстанавливаем характеристики окна .Left = LeftW .Top = TopW .Height = HeightW .Width = WidthW .WindowState = StateW End With End Sub |
| Пример 1.1. |
| Закрыть окно |
|
Public Sub WorkWithExcel() ' НЕ забудьте включить ссылку на Excel в меню References 'Объявление и создание объектов Excel.Application Dim MyXlApp As New Excel.Application 'Работа с приложением Excel With MyXlApp .Visible = True 'Excel появился на линейке и его можно раскрыть 'Добавить новую книгу .Workbooks.Add 'Теперь можно работать и с ячейками данной книги .Range("A1") = "Hello!" 'Идет работа с книгой .Range("B1") = "By-By" .Workbooks(1).Activate 'Закрываем открытую книгу MsgBox ("Закрываем рабочую книгу Excel?") .Workbooks(1).Close 'Будет задан вопрос о необходимости сохранения книги 'Закрываем приложение .Quit End With End Sub Public Sub WorkWithAccess() 'НЕ забудьте включить ссылку на Access и Dao 3.6 в меню References 'Приложение Access и его компоненты: 'База данных, форма и путь к базе Dim MyAc As New Access.Application Dim MFDb As Database Dim FormPoetAges As Form Dim PathDb As String 'Открываем базу данных Access PathDb = "E:\O2000\CD2000\Ch1\AgeOfPoet.mdb" MyAc.OpenCurrentDatabase (PathDb) Set MFDb = MyAc.CurrentDb 'Открываем форму MyAc.DoCmd.OpenForm ("AgeOfPoets") Set FormPoetAges = MyAc.Forms("AgeOfPoets") MyAc.Visible = True FormPoetAges.SetFocus 'Закрываем базу данных MsgBox ("Закрываем базу данных Access?") MyAc.Quit End Sub |
| Пример 1.2. |
| Закрыть окно |
|
Public Sub WorkWithbooks() ' Работа с коллекцией книг Dim N As Long, i As Byte Dim PathDir As String PathDir = "e:\O2000\CD2000\Ch1\" With Workbooks N = .Count Debug.Print "Число рабочих книг в коллекции Workbooks " & _ "при открытии приложения Excel = ", N ' Добавление 2-х новых книг .Add .Add 'Добавление двух существующих книг .Open (PathDir & "BookThree.xls") .Open (PathDir & "BookFive.xls") N = .Count Debug.Print "Число книг после 2-х вызовов методов Add и Open =", N Debug.Print "Имена книг в коллекции:" For i = 1 To .Count Debug.Print .Item(i).Name Next 'Закрытие двух книг и, следовательно, удаление их из коллекции .Item(2).Close .Item(3).Close N = .Count Debug.Print "Число книг после двух вызовов метода Close =", N Debug.Print "Имена книг, оставшихся в коллекции:" For i = 1 To .Count Debug.Print .Item(i).Name Next End With End Sub |
| Пример 1.3. |
| Закрыть окно |
| Public Sub WorkWithSheets() 'Работа с коллекцией Sheets - листами рабочей книги Dim N As Long, i As Byte Dim X As Variant 'Активизация книги Book2 Workbooks("Book2").Activate With ActiveWorkbook.Sheets N = .Count Debug.Print " Число листов при первоначальном открытии" _ & "книги = ", N Debug.Print "Имена листов:" For i = 1 To .Count Debug.Print .Item(i).Name Next ' Переименование листов .Item(1).Name = "Two" .Item(2).Name = "Four" .Item(3).Name = "Six" 'Добавление листов One, Three, Five .Add Before:=.Item("Two") .Add After:=.Item("Two"), Type:=xlChart .Add After:=.Item("Four"), Type:=xlExcel4MacroSheet .Item(1).Name = "One" .Item(3).Name = "Three" .Item(5).Name = "Five" N = .Count Debug.Print "Число листов книги после вставки" _ & "3-х листов =", N Debug.Print "Имена и типы листов после переименования:" For i = 1 To .Count Debug.Print .Item(i).Name, .Item(i).Type Next 'Удаление 3-го и 5-го листов .Item("Three").Delete .Item("Five").Delete 'Работа с первым листом .Item("One").Activate 'Запуск макроса Fibonachi, заполняющего область листа A1:A20 'последовательностью чисел Фибоначчи Fibonachi 'Копирование первого листа на вновь создаваемый третий лист .Item("One").Copy After:=.Item("Two") 'Переименование и перемещение листа ActiveSheet.Name = "Seven" .Item("Seven").Move After:=.Item("Six") 'Копирование области одного листа на последовательность листов X = Array("One", "Four", "Six") Sheets(X).FillAcrossSheets Range:=Worksheets("One").Range("A1:A20") Debug.Print "Имена,типы листов и содержимое двадцатой ячейки:" For i = 1 To .Count Debug.Print .Item(i).Name, .Item(i).Type, _ .Item(i).Range("A20").Value Next End With End Sub |
| Пример 1.4. |
| Закрыть окно |
| Public Sub WorkWithDocuments() 'Работа с коллекцией документов Dim N As Long, I As Byte Dim PathDir As String PathDir = "e:\O2000\CD2000\Ch1\" With Documents N = .Count Debug.Print "Число документов в коллекции Documents " & _ "при открытии приложения Word = ", N ' Добавление 2-х новых документов (второй представляет шаблон) .Add .Add NewTemplate:=True 'Добавление двух существующих документов .Open (PathDir & "DocThree") .Open (PathDir & "DocFive") N = .Count Debug.Print "Число документов после 4-х вызовов методов " _ & "Add и Open =", N Debug.Print "Имена документов в коллекции:" For I = 1 To .Count Debug.Print .Item(I).Name Next 'Закрытие двух документов и, следовательно, удаление их из коллекции .Item(2).Close .Item(3).Close N = .Count Debug.Print "Число документов после двух вызовов " _ & "метода Close =", N Debug.Print "Имена документов, оставшихся в коллекции:" For I = 1 To .Count Debug.Print .Item(I).Name Next End With End Sub |
| Пример 1.5. |
| Закрыть окно |
|
Public Sub WorkWithSecAndPar() 'Работа с разделами и абзацами 'Добавление новой книги Documents.Add Documents(1).Activate With ActiveDocument 'Вставка двух разделов в документ 'Раздел начнется с нечетной страницы .Sections.Add Start:=wdSectionOddPage .Sections.Add ' Вставка абзаца во второй раздел .Sections(2).Range.Paragraphs.Add .Sections(2).PageSetup.LeftMargin = 3 .Sections(2).Range.Style = "Heading 1" .Sections(2).Range.Font.Name = "Arial" .Sections(2).Range.Paragraphs(1).Range.InsertBefore ("Лекция 1") 'Вставка нового раздела и абзаца .Sections.Add Start:=wdSectionNewPage .Sections.Last.Range.Paragraphs.Last.Range.InsertBefore ("Параграф 1") .Sections.Last.Range.Paragraphs.Add 'Вставка нового раздела и абзаца .Sections.Add Start:=wdSectionNewPage .Sections.Last.Range.Paragraphs.Last.Range.InsertBefore ("Параграф 2") .Sections.Last.Range.Paragraphs.Add 'Вставка нового раздела в конец документа 'Раздел начнется с нечетной страницы .Sections.Add Start:=wdSectionOddPage .Sections.Last.PageSetup.LeftMargin = 23 .Sections.Last.Range.Font.Name = "TimesNewRoman" 'Вставка абзаца .Sections.Last.Range.Paragraphs(1).Range.InsertBefore ("Лекция 2") .Sections.Last.Range.Paragraphs.Add Debug.Print "Число разделов документа =", .Sections.Count Debug.Print "Число абзацев документа =", .Paragraphs.Count 'Удаление раздела выполняет метод объекта Range .Sections(1).Range.Delete Debug.Print "Число разделов документа =", .Sections.Count End With End Sub |
| Пример 1.6. |
| Закрыть окно |
| Public Sub WorkWithRange() Dim myr As Range, myr1 As Range Dim i As Byte 'Добавляем новый документ Documents.Add With ActiveDocument 'Добавляем 7 абзацев в текст созданного документа For i = 1 To 7 .Paragraphs.Last.Range.Text = "Абзац " & i .Paragraphs.Add Next i 'Используется свойство Range Set myr = .Paragraphs(1).Range 'Выделен первый абзац myr.Select 'Новый объект myr1 задает пустой объект - позицию курсора 'В правой части вызывается метод Range Set myr1 = ActiveDocument.Range(Start:=myr.Start, End:=myr.Start) myr1.Select 'Теперь объект myr1 задает единственный символ -первый символ текста 'Здеесь использован метод SetRange myr1.SetRange Start:=myr1.Start, End:=myr1.End + 1 myr1.Select 'Три абзаца с третьего по пятый выделяются курсивом myr1.SetRange Start:=.Paragraphs(3).Range.Start, End:=.Paragraphs(5).Range.End myr1.Font.Italic = True myr1.Select End With End Sub |
| Пример 1.7. |
| Закрыть окно |
| Public Sub WorkWithSelection() Dim myr As Range Dim i As Byte 'Добавляем новый документ Documents.Add With ActiveDocument 'Добавляем 7 абзацев в текст созданного документа For i = 1 To 7 .Paragraphs.Last.Range.Text = "Абзац " & i .Paragraphs.Add Next i 'Используется свойство Range Set myr = .Paragraphs(1).Range 'Выделен первый абзац. Создаем объект Selection myr.Select 'Действия с объектом Selection 'Стягивание в начало абзаца - точку вставки Selection.MoveLeft 'Расширение на один абзац вправо, снова выделяя первый абзац Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend 'Передвинемся к началу третьего абзаца Selection.Move Unit:=wdParagraph, Count:=2 'Три абзаца с третьего по пятый выделяются курсивом Selection.MoveDown Unit:=wdParagraph, Count:=3, Extend:=wdExtend Selection.Font.Italic = True End With End Sub |
| Пример 1.8. |
| Закрыть окно |
|
Sub WorkWithTwoReg() ' Переключение между двумя областями выделения документа 'Создание двух областей Dim myRange1 As Range Dim myRange2 As Range Dim i As Byte Dim Answer As Variant ' Выбор пользователя 'Добавляем новый документ Documents.Add With ActiveDocument 'Добавляем 7 абзацев в текст созданного документа For i = 1 To 7 .Paragraphs.Last.Range.Text = "Абзац " & i .Paragraphs.Add Next i Set myRange1 = .Range(Start:=.Paragraphs(2).Range.Start, _ End:=.Paragraphs(3).Range.End) Set myRange2 = .Range(Start:=.Paragraphs(6).Range.Start, _ End:=.Paragraphs(7).Range.End) Answer = InputBox(prompt:=" Выберите область выделения (1/2)", _ Default:=1) If Answer = 1 Then myRange1.Select 'Макрос ItInSel работает с первой выделенной областью ItInSel Else myRange2.Select 'Макрос ItInSel работает со второй выделенной областью ItInSel End If End With End Sub |
| Пример 1.9. |
| Закрыть окно |
