Создание стиля таблицы vba

Автор Тема: Создание стиля таблицы vba  (Прочитано 3628 раз)

0 Пользователей и 2 Гостей просматривают эту тему.

Оффлайн TimofeevАвтор темы

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Создание стиля таблицы vba
« : 01-02-2021, 11:42:13 »
Просьба помочь разобраться нашел пример создания текстового стиля для таблицы из Excel - ошибка на ошибке - не могу никак настроить эту функцию - Private Function MakeTableStyleForSpec() As String
Так же вопрос как задать текст Isocpeur
И еще один мини-вопрос как отмасштабировать вставленную таблицу
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Private Type ScaleFactor
  3.     X As Double 'Объявляем переменные
  4.    Y As Double
  5.     Z As Double
  6. End Type
  7. Private Function MakeTableStyleForSpec() As String
  8.     Dim acadDoc As Object
  9.     Dim AcadTableStyle As Object
  10.     Dim AcadTextStyle As Object
  11.     Dim AcadDictionary As Object
  12.     Dim strTableStyleName As String
  13.     Dim strTextStyleName As String
  14. Set AcadDictionary = acadDoc.Dictionaries.Item("ACAD_TABLESTYLE")
  15. strTableStyleName = "Оформление"
  16. On Error Resume Next
  17. Set AcadTableStyle = acadDoc.AcadDictionary.AddObject(strTableStyleName, "AcDbTableStyle")
  18. strTextStyleName = "Оформление_текст"
  19. Set AcadTextStyle = acadDoc.TextStyles.Add(strTextStyleName)
  20. On Error GoTo 0
  21. AcadTextStyle.SetFont "Arial", False, False, 0, 34 'значения получил по GetFont для нужного стиля
  22. AcadTableStyle.SetTextStyle AcRowType.acDataRow + AcRowType.acHeaderRow + AcRowType.acTitleRow + AcRowType.acUnknownRow, strTextStyleName
  23. AcadTableStyle.SetTextHeight AcRowType.acDataRow + AcRowType.acUnknownRow, 2.5
  24. AcadTableStyle.SetTextHeight AcRowType.acHeaderRow + AcRowType.acTitleRow, 3
  25. AcadTableStyle.SetAlignment AcRowType.acHeaderRow + AcRowType.acTitleRow, acMiddleCenter
  26. AcadTableStyle.SetAlignment AcRowType.acDataRow + AcRowType.acUnknownRow, acMiddleLeft
  27. AcadTableStyle.HorzCellMargin = 1.5
  28. AcadTableStyle.VertCellMargin = 1
  29. AcadTableStyle.SetGridLineWeight AcGridLineType.acHorzBottom + AcGridLineType.acHorzInside + AcGridLineType.acHorzTop _
  30.                 + AcGridLineType.acVertInside + AcGridLineType.acVertLeft + AcGridLineType.acVertRight, _
  31.                 AcRowType.acTitleRow + AcRowType.acHeaderRow, AcLineWeight.acLnWt050
  32. AcadTableStyle.SetGridLineWeight AcGridLineType.acHorzBottom + AcGridLineType.acHorzTop + _
  33.                AcGridLineType.acVertInside + AcGridLineType.acVertLeft + AcGridLineType.acVertRight, _
  34.                AcRowType.acDataRow + AcRowType.acUnknownRow, AcLineWeight.acLnWt050
  35. AcadTableStyle.SetGridLineWeight AcGridLineType.acHorzInside, _
  36.                AcRowType.acDataRow + AcRowType.acUnknownRow, AcLineWeight.acLnWt025
  37. Dim color As New AcadAcCmColor
  38. color.SetRGB 255, 0, 0
  39. AcadTableStyle.SetColor AcRowType.acDataRow + AcRowType.acHeaderRow _
  40.                         + AcRowType.acTitleRow + AcRowType.acUnknownRow, color
  41. MakeTableStyleForSpec = strTableStyleName
  42. End Function
  43. Sub Tabl()
  44.     Dim acadApp As Object 'Объявляем переменные
  45.    Dim acadDoc As Object
  46.     Dim acadTable As Object
  47.     Dim LastRow As Long
  48.     Dim i As Long
  49.     Dim InsertionPoint(0 To 2) As Double
  50.     Dim value As String
  51.         Dim AcadTableStyle As Object
  52.         Dim AcadTextStyle As Object
  53.         Dim AcadDictionary As Object
  54.         Dim strTableStyleName As String
  55.         Dim strTextStyleName As String
  56.     With Sheets("Coordinates") 'Делаем активным лист координаты
  57.        .Activate
  58.         LastRow = .Cells(.Rows.Count, "AS").End(xlUp).Row 'Ищем последнюю заполненную строку столбца AS
  59.    End With
  60.     If LastRow < 4 Then 'Если номер последней строки меньше чем 4
  61.        MsgBox "Нет значений для вставки", vbCritical, "Ошибка отсутствие значений"
  62.         Exit Sub
  63.     End If
  64.     On Error Resume Next
  65.     Set acadApp = GetObject(, "AutoCAD.Application") 'Проверяем открыт ли автокад
  66.    If acadApp Is Nothing Then 'Если автокад не открыт
  67.        Set acadApp = CreateObject("AutoCAD.Application") 'Создаем новую сессию автокад
  68.        acadApp.Visible = True 'Делаем автокад видимым
  69.    End If
  70.     If acadApp Is Nothing Then 'Если опять автокад не открыт
  71.        MsgBox "Извините, но мы не можем запустить автокад", vbCritical, "Ошибка запуска автокад"
  72.         Exit Sub
  73.     End If
  74.     On Error GoTo 0 'Если ошибка то идем хз куда
  75.    On Error Resume Next 'Если ошибка то идем дальше
  76.    Set acadDoc = acadApp.ActiveDocument 'Присваиваем переменную активному чертежу автокада
  77.    If acadDoc Is Nothing Then 'Если ни один чертеж автокада не активен
  78.        Set acadDoc = acadApp.Documents.Add 'Создаем новый чертеж
  79.    End If
  80.     On Error GoTo 0 'Если ошибка то идем хз куда
  81.    If acadDoc.ActiveSpace = 0 Then '0 = acPaperSpace in early binding. Если чертеж открыт не в модели, а в листах
  82.        acadDoc.ActiveSpace = 1     '1 = acModelSpace in early binding. Делаем активной модель
  83.    End If
  84.     With Sheets("Coordinates")  'С листом Coordinates Excel
  85.                InsertionPoint(0) = .Range("AS" & 1).value 'Задаем координату X вставки блока
  86.                InsertionPoint(1) = .Range("AT" & 1).value 'Задаем координату Y вставки блока
  87.                InsertionPoint(2) = .Range("AU" & 1).value 'Задаем координату Z вставки блока
  88.                Set acadTable = acadDoc.ModelSpace.AddTable(InsertionPoint, 2, 5, 10, 20) 'Вставляем таблицу в чертеж
  89.                acadTable.RegenerateTableSuppressed = True
  90.                 acadTable.DeleteRows 0, 1 'удаляем 1 строчку заголовка таблицы
  91.                acadTable.SetTextHeight 3, 3
  92.                 acadTable.SetTextHeight 4, 3
  93.                 acadTable.SetText 0, 0, .Range("AS" & 2).value
  94.                 acadTable.SetColumnWidth 0, 15
  95.                 acadTable.SetText 0, 1, .Range("AT" & 2).value
  96.                 acadTable.SetColumnWidth 1, 70
  97.                 acadTable.SetText 0, 2, .Range("AU" & 2).value
  98.                 acadTable.SetColumnWidth 2, 50
  99.                 acadTable.SetText 0, 3, .Range("AV" & 2).value
  100.                 acadTable.SetColumnWidth 3, 40
  101.                 acadTable.SetText 0, 4, .Range("AW" & 2).value
  102.                 acadTable.SetColumnWidth 4, 30
  103.                 'acadTable.RegenerateTableSuppressed = True
  104.                    For i = 1 To LastRow - 3
  105.                         acadTable.InsertRows i, 10, 1
  106.                         acadTable.SetTextHeight 3, 3
  107.                         acadTable.SetTextHeight 4, 3
  108.                         'acadTable.RegenerateTableSuppressed = True
  109.                        acadTable.SetText i, 0, .Range("AS" & i + 3).value
  110.                         acadTable.SetText i, 1, .Range("AT" & i + 3).value
  111.                         acadTable.SetText i, 2, .Range("AU" & i + 3).value
  112.                         acadTable.SetText i, 3, .Range("AV" & i + 3).value
  113.                         acadTable.SetText i, 4, .Range("AW" & i + 3).value
  114.                     Next
  115.                 acadTable.RegenerateTableSuppressed = False
  116.                 acadTable.StyleName = MakeTableStyleForSpec
  117.                 'acadTable.RegenerateTableSuppressed = True
  118.    End With ' Завершение взятия данных с листа эксель
  119.    acadApp.ZoomExtents ' Двойное нажатие на колесико мыши
  120.    Set acadDoc = Nothing ' ХЗ зачем обнуляем наверное перменные
  121.    Set acadApp = Nothing ' ХЗ зачем обнуляем наверное перменные
  122. End Sub
« Последнее редактирование: 01-02-2021, 13:10:03 от Timofeev »

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Создание стиля таблицы vba
« Ответ #1 : 01-02-2021, 17:46:45 »
Timofeev,
Один вопрос - одна тема.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Создание стиля таблицы vba
« Ответ #2 : 01-02-2021, 17:53:05 »
Просьба помочь разобраться нашел пример создания текстового стиля для таблицы из Excel
Так текстового стиля или стиля таблицы? Это совершенно разные вещи.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн TimofeevАвтор темы

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Создание стиля таблицы vba
« Ответ #3 : 01-02-2021, 18:29:03 »
Стиль таблицы + в нём шрифт Isocpeur

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 13829
  • Карма: 1784
  • Рыцарь ObjectARX
  • Skype: rivilis
Re: Создание стиля таблицы vba
« Ответ #4 : 01-02-2021, 18:53:43 »
Стиль таблицы + в нём шрифт Isocpeur
Тогда как минимум ты должен начать с создания текстового стиля со шрифтом Isocpeur.ttf
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн TimofeevАвтор темы

  • ADN OPEN
  • Сообщений: 47
  • Карма: 0
Re: Создание стиля таблицы vba
« Ответ #5 : 02-02-2021, 19:48:43 »
Все что нашел:
Создание и изменение текстового стиля
Исключая стиль по умолчанию standard можно создавать любой собственный. Вновь вводимый текст наследует высоту, ширину, угол и др. свойства текущего стиля. После создания стиля текст имя его изменить нельзя. AutoCAD автоматически преобразует имя стиля в верхний регистр. Если не вводить имя, то оно будет Style[N] где N следующее числовое значение. Изменение текущего текстового стиля осуществляется модификацией свойств объекта TextStyle.
FontFile - задает файл связанный со шрифтом;
BigFontFile - задает форму не ASCII-символов;
Height - задает высоту символа;
Width - задает сжатие или растяжение символов;
ObliqueAngle - задает угол наклона текста;
TextGenerationFlag - задает зеркальный, перевернутый или оба.
Если изменить ориентацию текстового стиля все ранее введенные тексты этим стилем изменят ориентацию, изменение же размера, ширины, наклона так не влияет на ранее введенный текст. Впрочем поведение довольно загадочно, иногда меняется и отображение ранее введенного текста в последнем случае. Шрифт определяет форму символов. Один шрифт может быть использован для создания различных стилей. Пример назначении текстового стиля.
Код - Visual Basic [Выбрать]
  1. Sub UpdateTextFont()
  2.   Dim typeFace As String
  3.   Dim Bold As Boolean
  4.   Dim Italic As Boolean
  5.   Dim charSet As Long
  6.   Dim PitchandFamily As Long
  7.   ThisDrawing.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily
  8.   typeFace = "PlayBill"
  9. ' Установить ранее созданный текстовой стиль
  10.  ThisDrawing.ActiveTextStyle.SetFont typeFace, Bold, Italic, charSet, PitchandFamily
  11.   ThisDrawing.Regen acActiveViewport
  12. End Sub
« Последнее редактирование: 02-02-2021, 20:22:25 от Timofeev »