Это продолжение темы внутренних выгод, которые были в системе и которые мне нужно было для себя как-то считать. Не то чтобы очень нужно было, но и не мешало. С людьми постарше проблем не было. Им достаточно было того, что они тратят на работу чуть меньше времени и значит могут пить чай и болтать чуть больше. Не знаю конечно точно, что они делали, но как-то развлекали себя сами.
А вот одна девушка меня как-то озадачила необычной задачей: придумать ей какое-то интересное занятие на то время, когда ей нечего делать. Идею подсказала она сама, когда в следующий раз пришла с вопросом: «Что такое макрОсы? Это такие очень больше файлы?». Пришлось объяснить, что не «макрОсы» а «мАкросы» и нарисовать эту бумажку. К тому же конструктора строго категорически потребовали кнопку, по которой в AutoCAD-е будет рисоваться текст, огибающий выделенную дугу. Он тоже попал в документ как единственный осмысленный пример.
Обычная структура приложения:
Названия для разных приложений:
Название прило-жения
|
Документ
|
Объекты
|
Элемен- ты
|
Access
|
DbEngine.Workspaces(0).DataBases(0)
|
TableDefs
QueryDefs
|
Fields
|
Excel
|
Application.Workbooks(1)
|
Sheets
|
Cells
|
Word
|
ActiveDocument
|
Words
Paragraphs
|
|
AutoCAD
|
ThisDrawing.ModelSpace
|
Item
|
|
CorelDRAW
|
ThisDocument.ActivePage
|
Layers
|
Shapes
|
Примеры доступа к элементам:
Access:
DbEngine.Workspaces(0).DataBases(0).TableDefs(1).name – название первой таблицы
Excel:
Application.Workbooks(1).Sheets(1).Name – название первого листа
Word:
ActiveDocument.Words(1) – первое слово в документе
AutoCAD:
ThisDrawing.ModelSpace.Item(1).ObjectName – тип первого нарисованного на странице объекта (линия, дуга, круг и т.д.)
CorelDRAW:
ThisDocument.ActivePage.Layers(1).Shapes(1).PositionX – X координата первого нарисованного на странице объекта
Создание, корректировка макросов (редактор):
Приложение
|
Запуск
|
Access
|
Вкладка “Модули”
|
Excel
|
Сервис->Макрос->Макросы->Изменить
|
Word
|
Сервис->Макрос->Макросы->Изменить
|
AutoCAD
|
Tools->Macro->Macros->Edit
|
CorelDRAW
|
Tools->Visual Basic->Play->Edit
|
Примеры кода:
Access:
‘ Обработчик нажатия кнопки с именем “Butt” в форме
‘ Выводит на экран имя первой созданной таблицы и названия ее полей
Private Sub Butt_Click()
Dim dbsBase As Database
Dim j As Integer
Set dbsBase = DBEngine.Workspaces(0).Databases(0)
' Название первой таблицы :
MsgBox ("Первая таблица называется " & dbsBase.TableDefs(1).Name)
' Список полей первой таблицы:
For j = 0 To dbsBase.TableDefs(1).Fields.Count - 1
MsgBox ("Поле N " & Str(j) & " " & _
"Название " & dbsBase.TableDefs(1).Fields(j).Name)
Next j
End Sub
Excel:
‘ Вычисляет сумму значений ячеек с координатами из текущего листа по всем листам
‘ предшествующим текущему
Sub Sum_Previos()
Dim nRow As Integer, nCol As Integer ' Координаты ячейки
Dim j As Integer ' Счетчик
Dim nSum As Double ' Сумма
Dim strNameActive As String ' Название текущего листа
' Информация о текущем положении курсора:
nRow = ActiveCell.Row ' Положение ячейки
nCol = ActiveCell.Column
strNameActive = ActiveSheet.Name ' Название листа
' Обнуление суммы:
nSum = 0
' Переход на первый лист документа:
Application.Workbooks(1).Sheets(1).Activate
' Цикл: с первого до текущего листа:
j = 1
While Application.Workbooks(1).Sheets(j).Name <> strNameActive
Application.Workbooks(1).Sheets(j).Activate ' Переход на лист
nSum = nSum + Cells(nRow, nCol) ' Увеличение суммы
j = j + 1
Wend
' Переход на лист, где были вначале:
Application.Workbooks(1).Sheets(strNameActive).Activate
' Запись в ячейку суммы:
ActiveCell.FormulaR1C1 = nSum
End Sub
Word:
‘ Во всем документе выделяет жирным шрифтом отцентрованные строке и курсивом
‘ слова , длина которых больше 5 символов
Sub Example_Word()
Dim j As Integer
For j = 1 To ActiveDocument.Words.Count
If ActiveDocument.Words(j).ParagraphFormat.Alignment = wdAlignParagraphCenter Then
ActiveDocument.Words(j).Font.Bold = True
End If
If Len(ActiveDocument.Words(j)) > 5 Then
ActiveDocument.Words(j).Font.Italic = True
End If
Next j
End Sub
AutoCAD:
‘ Располагает вводимый текст на выделяемой дуге (позволяет выделить дугу и ввести текст)
Sub Text_on_arc()
Dim ssetObj As AcadSelectionSet ' Выделенный объект
Dim strString As String ' Выводимый текст
Dim intLen As Integer ' Длина строки
Dim j As Integer ' Счетчик
Dim objArc As AcadArc ' Объект - дуга
Dim dblStartAngle As Double ' Начальный угол
Dim dblEndAngle As Double ' Конечный угол
Dim dblRadius As Double ' Радиус дуги
Dim dblOx As Double, dblOy As Double ' Центр дуги
Dim dblAlfa As Double ' Угол смещения одной буквы
Dim dblX As Double, dblY As Double ' Координаты буквы
Dim textObj As AcadText ' Объект - Текст, одна буква
Dim insertionPoint(0 To 2) As Double ' Координаты буквы в виде массива
Dim strOneSign As String ' Одна буква
Dim dblRotateAngle As Double ' Угол поворота буквы
If ThisDrawing.SelectionSets.Count = 0 Then ' Если не было объявленных в макросах выделений
Set ssetObj = ThisDrawing.SelectionSets.Add("SELECT_ARC") ' Создаем его
Else
Set ssetObj = ThisDrawing.SelectionSets.Item(0) ' Взять объект - выделение
ssetObj.Clear ' Удалить предыдущую информацию
End If
ssetObj.SelectOnScreen ' Отметитить объект на экране
If ssetObj.Item(0).ObjectName = "AcDbArc" Then ‘ Если выделенный элемент - дуга
strString = InputBox("Введите строку:") ' Ввести текст, который д.б. размещен на дуге
intLen = Len(strString) ' Кол-во символов в строке
' Параметры дуги :
Set objArc = ssetObj.Item(0)
dblRadius = objArc.Radius
dblStartAngle = objArc.StartAngle ' Углы в радианах
dblEndAngle = objArc.EndAngle
dblOx = objArc.center(0) ' центр "дуги" :
dblOy = objArc.center(1)
dblAlfa = (dblEndAngle - dblStartAngle) / (intLen - 1) ' Угол смещения буквы
' Цикл по буквам :
For j = 1 To intLen
dblX = dblOx - dblRadius * Cos(3.14159 - dblEndAngle + (j - 1) * dblAlfa)
dblY = dblOy + dblRadius * Sin(3.14159 - dblEndAngle + (j - 1) * dblAlfa)
' Заполнение массива координат точки :
insertionPoint(0) = dblX
insertionPoint(1) = dblY
insertionPoint(2) = 0 ' Координата Z
strOneSign = Mid(strString, j, 1) ‘ Одна буква из строки
' Добавление текста, высота буквы = 10 (последний параметр)
Set textObj = ThisDrawing.ModelSpace.AddText(strOneSign, insertionPoint, 10)
' Поворачиваем буквы на определенный угол, в зависимости от положения на дуге:
dblRotateAngle = 1.5 * 3.14159 + dblEndAngle - (j - 1) * dblAlfa
textObj.Rotate insertionPoint, dblRotateAngle
Next j
Else
MsgBox ("Click-ать надо было дугу (ARC)" & Chr(13) & "а это не дуга !")
End If
End Sub
Результат выглядит примерно так:
|