Редактор кода

Для создания программных кодов используется редактор кода, окно которого открывается одной из команд:

• Выполнить команду View / Code.

• Из контекстного меню выполнить команду View Code.

Для каждого модуля создается отдельное окно кода, разделенное внутри на секции. Выбор секции осуществляется с помощью списка Object, расположенного слева в верхней части окна.

Для стандартного модуля этот список содержит общую секцию General. В модуле класса в этот список включены: общая секция и секция классов.

В модуле формы список Object содержит общую секцию, секцию для формы (Form), а также секции для всех размещённых на форме объектов. Для каждой выбранной секции можно создать процедуру, выбрав ее из списка Procedure в правом верхнем углу окна редактора кода, содержащего события. Для элемента списка General из списка Object есть только одно значение Declarations (Объявления) в списке Procedure.

Приложение 2 примеры макросов для приложений microsoft ofice1

1. Конвертирование документа Word в текстовый файл (*.txt)

Код открывает Word в памяти компьютера и производит конвертирование документа.

Перед работой в Reference... поставьте ссылку наMicrosoftWordObjectLibrary.

Private Sub Command1_Click()

Dim temp As String

temp = "путь & имя.doc"

If Not Dir(temp, vbNormal) <> "" Then

MsgBox "Документ не найден."

Exit Sub

End If

On Error GoTo Notloaded

Set MyWord = GetObject (, "Word.Application")

Notloaded:

If Err.Number = 429 Then

Set MyWord = CreateObject("Word.Application")

ElseIf Err.Number <> 0 Then

Screen.MousePointer = vbDefault

'Пользователь нажал на кнопку Cancel

MyWord.Documents.Close SaveChanges:= wdDoNotSaveChanges

Set MyWord = Nothing

Screen.MousePointer = 0

If Not Err.Number = 32755 Then

MsgBox Err.Description & vbCrLf & "error "

End If

Err.Clear

Exit Sub

End If

MyWord.Documents.Open FileName:=temp

MyWord.ActiveDocument.SaveAs FileName:="name.txt", _

FileFormat:=wdFormatText, LockComments:=False, _

Password:="", AddToRecentFiles:=True, WritePassword:="",_

ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _

SaveNativePictureFormat:=False, SaveFormsData:=False, _

SaveAsAOCELetter:=False

End Sub

2. Считывание текста документа Word не открывая его.

Код открывает Wordв памяти компьютера и производит считывание.

Перед работой в Reference... поставьте ссылку наMicrosoftWordObjectLibrary.

Option Explicit

Dim objWord As Word.Application

Private Sub Command1_Click()

On Error Resume Next

Dim strDocPath As String , D

strDocPath = "D:\Advice\Soveti\DragDropTXT.doc"

Set objWord = New

Word.Application

objWord.Visible = False

objWord.Documents.Open strDocPath, False

objWord.Selection.WholeStory

D = objWord.Selection.Text

objWord.ActiveDocument.Close

objWord.Quit

Set objWord = Nothing

Debug.Print D

End Sub

3. Форматирование печатной области документа

Код задает отступы слева, справа, сверху и снизу в сантиметрах.

Перед работой в Reference... поставьте ссылку наMicrosoftWordObjectLibrary.

Private Sub Command2_Click()

DocWord.Application.Selection.PageSetup.LeftMargin = _ CentimetersToPoints(2)  'отступ слева "2,0 см"

DocWord.Application.Selection.PageSetup.RightMargin = _ CentimetersToPoints(1.5)  'отступ справа "1,5 см"

DocWord.Application.Selection.PageSetup.TopMargin = _ CentimetersToPoints(3.5)  'отступ сверху "3,5 см"

DocWord.Application.Selection.PageSetup.BottomMargin = _ CentimetersToPoints(4.45)  'отступ снизу "4,45 см"

End Sub

4. Вставка таблицы в текстовый документ

Создается таблица из 10 строк в 2 столбца на всю ширину области печати текста.

В коде используется коллекция Tables. Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Dim TableWord As Word.Table 'объявляем объектную

‘переменную в разделе Generals формы

Set TableWord = DocWord.Tables.Add(DocWord.Range(), 10, 2)

‘таблица перекроет весь текст, который был в документе

‘("удалит" его)

или

SetTableWord=DocWord.Tables.Add(DocWord.Application._ Selection.Range, 10, 2)‘таблицу туда, где находится в

‘данный момент "мигающий" курсор

5. Запрет повторного открытия файла Excel

Проверяется, открыт ли запрашиваемый файл, и если открыт, вторичный запрос останавливается.

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

For Each Workbook In Application.Workbooks

If Workbook.Name = "Наименование книги (Book1)" Then Stop

Next

6. Добавление данных ячеек листа Excel в ListBox формы

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Расположить на форме ListBox1, добавить код, введите данные в ячейкиA1-B4 на листе, и запустить Макрос.

Private Sub UserForm_Initialize()

ListBox1.ColumnCount = 5

ListBox1.RowSource = "a1:b4"

ListBox1.ControlSource = "a6"

ListBox1.BoundColumn = 0

End Sub

7. Добавление в книгу Excel нового листа

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Dim ExNew As Worksheet

Set ExNew = ActiveWorkbook.Worksheets.Add

ExNew.Name = "Имя Листа"

8. Добавление на лист Excel кнопки вызова браузера

Добавить на лист кнопку, объявить переменные и добавить код.

Private Declare Function ShellExecute& Lib "shell32.dll"_

Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal _

lpOperation As String, ByVal lpFile As String, ByVal _

lpParameters As String, ByVal lpDirectory As String, _

ByVal nShowCmd As Long)

Private Declare Function GetDesktopWindow Lib_

"user32" () As Long

Const SW_SHOWNORMAL = 1

Sub Button1_Click()

Call ShellExecute(GetDesktopWindow, "Open",_

"www.armentel.com/avb", "", "c:\", SW_SHOWNORMAL)

End Sub

9. Проверка наличия в книге искомого листа

В книге ищется лист «Sheet1».

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

For Each sheet In Worksheets

If sheet.Name = "Sheet1" Then

MsgBox "Sheet1 существует"

Exit For

End If

Next

10. Открытие из Excel базы данных и считывание данных из ее таблицы в ячейки листа.

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Dim WS As Workspace

Dim DB As Database

Dim RS As Recordset

Dim strSQL As String

Dim strDBPath As String

Dim i As Integer

strDBPath = "C:\Program Files\Microsoft Visual _ Studio\VB98\Biblio.mdb"'Путь к Базе Данных

'Открываем рабочую область:

SetWS = DBEngine.Workspaces(0)

'Открываем БД, где strDBPath – полный путь к БД (у вас он 'может быть чуть иным), False – означает, что мы открываем 'БД не в режиме Exclusive (False), и для Read\Write

'(False)

Set DB = WS.OpenDatabase(strDBPath, False, False)

'Открываем таблицу Publishers, записываем в стринговую переменню SQL запрос и передаем Рекордсету

strSQL = "SELECT PubID, Name, Address, City, Telephone FROM Publishers"

Set RS = DB.OpenRecordset(strSQL)

'Производим в цикле запись из БД согласно SQL запросу на

'лист Excel

i = 2

While RS.EOF = False

Sheets("sheet1").Range("a" + LTrim(Str(i))) = _ RS.Fields(0)

Sheets("sheet1").Range("b" + LTrim(Str(i))) = _ RS.Fields(1)

Sheets("sheet1").Range("c" + LTrim(Str(i))) = _ RS.Fields(2)

Sheets("sheet1").Range("d" + LTrim(Str(i))) = _ RS.Fields(3)

Sheets("sheet1").Range("e" + LTrim(Str(i))) = _ RS.Fields(4)

i = i + 1

RS.MoveNext

Wend

MsgBox "ГОТОВО"

11. Создание нового файла Excel

Код создает новый файл и новый лист.

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Set objExcel = New Excel.Application

objExcel.Visible = False

Set objWB = objExcel.Workbooks.Add

Set objSH = objExcel.Worksheets.Add

objExcel.ActiveWorkbook.SaveAs "Путь и имя файла"

objExcel.Quit

Set objExcel = Nothing

MsgBox "Файл " & "Путь и имя файла" & " создан", vbInformation, Tit

12. Добавление в ячейку данных через Visual Basic

Код открывает файл не отображая его, добавляет в ячейку А2 текст «VisualBasic», сохраняет и закрывает файл.

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Dim Ex As New Excel.Application

Ex.Workbooks.Open <путь к Файлу>

Ex.Visible = False

'В ячейку "A2" добавляем "Visual Basic"

Ex.ActiveWorkbook.Sheets.Application.Range("A2") = "Visual_ Basic"

Ex.ActiveWorkbook.Save

Ex.ActiveWorkbook.Close

13. Вставка рисунка на лист

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

XL.Range("A1").Select'установить курсор в ячейку А1

XL.ActiveSheet.Pictures.Insert("C:\Picture.jpg").Select_'вставить рисунок в выбранную ячейку

14. Вырезание, копирование и вставка копированием

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Private Sub UserForm_Initialize()

TextBox1.Text = "Cut This text and Paste in Textbox2"

CommandButton1.Caption = "Cut and Paste"

CommandButton1.AutoSize = True

End Sub

Private Sub CommandButton1_Click()

TextBox1.SelStart = 0

TextBox1.SelLength = TextBox1.TextLength

TextBox1.Cut

'TextBox1.Copy

TextBox2.SetFocus

TextBox2.SelStart = 0

TextBox2.Paste

TextBox2.SelStart = 0

End Sub

15. Подсчет суммы в заданных ячейках

Перед работой в Reference... поставьте ссылку на Microsoft Excel Object Library.

Dim Ex As New Excel.Application

Ex.Workbooks.Open "Путь к файлу"

Ex.Visible = False

Ex.ActiveWorkbook.Sheets.Application.Range("B1:B14").Select

Ex.ActiveWorkbook.Sheets.Application.Range("B14").Activate

Ex.ActiveWorkbook.Sheets.Application.ActiveCell.FormulaR1C1 = "=SUM(R[-13]C:R[-1]C)"

Ex.ActiveWorkbook.Sheets.Application.Range("B14").Select

Text1.Text = _ Ex.ActiveWorkbook.Sheets.Application.Range("B14")

Ex.ActiveWorkbook.Save

Ex.ActiveWorkbook.Close

1Адрес ссылки