Суббота, 18.05.2024
Мой сайт
Меню сайта
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0
Главная » 2015 » Декабрь » 13 » Макросы
18:59
Макросы

Это продолжение темы внутренних выгод, которые были в системе и которые мне нужно было для себя как-то считать. Не то чтобы очень нужно было, но и не мешало. С людьми постарше проблем не было. Им достаточно было того, что они тратят на работу чуть меньше времени и значит могут пить чай и болтать чуть больше. Не знаю конечно точно, что они делали, но как-то развлекали себя сами.
А вот одна девушка меня как-то озадачила необычной задачей: придумать ей какое-то интересное занятие на то время, когда ей нечего делать. Идею подсказала она сама, когда в следующий раз пришла с вопросом: «Что такое макрОсы? Это такие очень больше файлы?». Пришлось объяснить, что не «макрОсы» а «мАкросы» и нарисовать эту бумажку. К тому же конструктора строго категорически потребовали кнопку, по которой в 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
 

Результат выглядит примерно так:

 
   

 

 

 

 

 

Просмотров: 243 | Добавил: akostina76 | Рейтинг: 0.0/0
Всего комментариев: 0
Имя *:
Email *:
Код *:
Форма входа
Поиск
Календарь
Архив записей
Друзья сайта
  • Официальный блог
  • Сообщество uCoz
  • FAQ по системе
  • Инструкции для uCoz
  • Copyright MyCorp © 2024
    Бесплатный конструктор сайтов - uCoz