Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.01.2009, 04:45   #21
tolikman
Форумчанин
 
Регистрация: 25.08.2008
Сообщений: 159
Лампочка

Вот то, до чего додумался я линии.rar.
Так как проблема стояла в искажении форматирования содержания ячейки, то я подумал, а почему бы не создать новую строку в таблице в самом низу, и указать размер шрифта для всех ячее =1, что зделает ее минимальной, а так как у нас и так линия выходит за края, то вроде вариант подходит. создаем строку, убираем ее границы и т.д.
В результате создал класс WorkWithTable и модуль WWT_TEST.
НО не все так хорошо, не могу понять (для этого надо посмотреть вложение) почему когда я передаю в функцию drawLine задание рисовать горизонтальную линию, та в свою очередь обращаетя к функции getAnchor(), которая кажется и компостит мозги, так как в результате все вертикальные линии рисуются вдоль первого столбца
.
Viter.Alex, если можно сохранять все шэйпы в массив, то потом можно все выделить и Selection.ShapeRange.Group.Select, который записал макрорекордером.

Последний раз редактировалось tolikman; 11.01.2009 в 04:50.
tolikman вне форума Ответить с цитированием
Старый 11.01.2009, 12:53   #22
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

Я думал о пустой строке внизу, но слева или справа тогда тоже нужно вставлять пустой столбец. Это только запутывает. Лучше группировать. Только я не допру как в массив записывать все линии.
А почему так сложно сделал подсчет ширины и высоты таблицы? Почему не так?
Код:
Diim oCurrCol as Column
tableWidth = 0
For Each oCurrCol In WWTTable.Columns
  tableWidth = tableWidth + oCurrCol.Width
Next oCurrCol
А единицы измерения лучше выставлять сразу при инициализации класса.
Цитата:
Сообщение от tolikman Посмотреть сообщение
…та в свою очередь обращаетя к функции getAnchor(), которая кажется и компостит мозги, так как в результате все вертикальные линии рисуются вдоль первого столбца
Так ты же якорь ставишь к колонке, а нужно к тексту в ячейке Selection.Range, тогда и положение таблицы не нужно изменять. Посмотри, как я сделал в ThisDocument. Я не привязываюсь к положению таблицы, я якорь делаю именно к тексту. Кстати, я там снимаю выделение с ячейки через Selection.HomeKey, но для этого есть специальный метод Selection.Collapse. Удачи.
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 11.01.2009 в 15:05. Причина: Дополнение
viter.alex вне форума Ответить с цитированием
Старый 11.01.2009, 14:37   #23
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Цитата:
Только я не допру как в массив записывать все линии
А зачем, собственно, создавать массив объектов?

Записывай в массив (или лучше в коллекцию) имена фигур (линий) - они ведь не повторяются...

Потом по именам и обращайся к определённым линиям.

Не знаю как в Word-е, а в Excel-е в качестве параметра метода группировки фигур как раз передаётся массив имён фигур...
EducatedFool вне форума Ответить с цитированием
Старый 11.01.2009, 15:09   #24
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

Цитата:
Сообщение от EducatedFool Посмотреть сообщение
…Не знаю как в Word-е, а в Excel-е в качестве параметра метода группировки фигур как раз передаётся массив имён фигур...
В Word'e тоже,
Код:
ActiveDocumentShapes.Range(Array("fig1", "fig2")).Group
Я пытался передать массив в качестве аргумента, но он его не принял Массив формировал отдельно, конечно, с именами линий. Размер задавал для каждой таблицы отдельно через ReDim
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 11.01.2009 в 15:11.
viter.alex вне форума Ответить с цитированием
Старый 12.01.2009, 11:33   #25
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию Нашел решение!

Нашлось решение для того, чтобы не изменять форматирование в ячейке. Как я и говорил, нужно группировать объекты. Сделал, как и tolikman в виде класса
Код:
Option Explicit
Private nHorLinesCounter, nVertLinesCounter As Integer

Public Sub ClearLines()
  Dim oLine As Shape
  For Each oLine In ActiveDocument.Shapes
    oLine.Delete
  Next oLine
End Sub

Public Sub DrawHorLine(ByVal oTable As Table, ByVal oRow As Row)
  Dim nXStartPoint, nWidthOfLine As Double
'  Dim oLine As Shape
  Dim oAnchor As Range
  With oTable
    'положение X
    nXStartPoint = -1 * (MillimetersToPoints(5) + .Cell(oRow.Index, 1).LeftPadding)
    'ширина горизонтальной линии
    nWidthOfLine = dfGetTableWidth(oTable) + _
                  Abs(nXStartPoint) + _
                  .Cell(oRow.Index, 1).RightPadding
    'переходим в первую ячейку строки
    .Cell(oRow.Index, 1).Select: Selection.Collapse
    'Якорь к тексту в ячейке
    Set oAnchor = Selection.Range
    'Рисуем линию
    Set oLine = ActiveDocument.Shapes.AddLine _
                (nXStartPoint, _
                0, _
                1, _
                0, oAnchor) '
    nHorLinesCounter = nHorLinesCounter + 1
    'ключевой момент. В имя линии записываем ID таблицы, которой она принадлежит
    oLine.name = "Table_" & oTable.ID & "HorLine" & nHorLinesCounter
    'относительная позиция по строке
    oLine.RelativeVerticalPosition = wdRelativeVerticalPositionLine
    'расстояние от верха строки
    oLine.Top = (oRow.Height) / 2 '+ oRow.Height / 6
    'Устанавливаем ширину горизонтальной линии
    oLine.Width = nWidthOfLine
'        'если находимся не в последней строке, то выбираем следующую
'        If Not (oRow.IsLast) Then
'          .Rows(oRow.Index).Next.Select
'          Selection.HomeKey
'        End If
  End With
End Sub

Public Sub DrawVertLine(ByVal oTable As Table, ByVal oCol As Column)
  Dim nYStartPoint, nLenghtOfLine As Double
'  Dim oLine As Shape
  Dim oAnchor As Range
  With oTable
    'положение Y
    nYStartPoint = -1 * (MillimetersToPoints(5) + .Cell(1, oCol.Index).TopPadding)
    'длина вертикальной линии
    nLenghtOfLine = dfGetTableHeight(oTable) + _
                    2 * Abs(nYStartPoint) + _
                    .Cell(1, oCol.Index).BottomPadding - _
                    .Cell(1, oCol.Index).TopPadding
    'перейтив первую ячейку столбца
    .Cell(1, oCol.Index).Select: Selection.Collapse
    'Якорь к тексту в ячейке
    Set oAnchor = Selection.Range
    'Рисуем линию
    Set oLine = ActiveDocument.Shapes.AddLine _
                (0, _
                nYStartPoint, _
                0, _
                1, oAnchor)
    nVertLinesCounter = nVertLinesCounter + 1
    'ключевой момент. В имя линии записываем ID таблицы, которой она принадлежит
    oLine.name = "Table_" & oTable.ID & "VertLine" & nVertLinesCounter
    'выравниваем линию относительно центра колонки
    oLine.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
    oLine.Left = wdShapeCenter
    'запрет на перемещение линии мышкой
    oLine.LockAnchor = True: oLine.LayoutInCell = True
    'устанавливаем длину горизонтальной линии
    oLine.Height = nLenghtOfLine
  End With
End Sub

Private Function dfGetTableWidth(ByVal oTable As Table) As Double
  Dim oCurrCol As Column: Dim dTableWidth As Double
  For Each oCurrCol In oTable.Columns
    dTableWidth = dTableWidth + oCurrCol.Width
  Next oCurrCol
  dfGetTableWidth = dTableWidth
End Function

Private Function dfGetTableHeight(ByVal oTable As Table) As Double
  Dim oCurrRow As Row: Dim dTableHeight As Double
  For Each oCurrRow In oTable.Rows
    dTableHeight = dTableHeight + oCurrRow.Height
  Next oCurrRow
  dfGetTableHeight = dTableHeight
End Function

Public Sub GroupLinesForTable(ByVal oTable As Table)
  Dim oShape As Shape
  With oTable
    For Each oShape In ActiveDocument.Shapes
      If InStr(oShape.name, "Table_" & .ID) <> 0 Then ActiveDocument.Shapes.Range(oShape.name).Select (False)
    Next oShape
    With Selection.ShapeRange.Group
      .LockAnchor = True
    End With
  End With
End Sub
Процедура GroupLinesForTable проверяет все Shapes в документе на предмет наличия в их имени ID соотв. таблицы. Если есть такой ID в имени, то Shape добавляется в набор. Затем этот набор группируем. Форматирование в ячейке сохраняется.
tolikman, ты изменяешь положение таблицы в нулевое, чтобы в ней нарисовать линии. Зачем? Привязывайся к тексту в ячейке, тогда положение таблицы тебя уже не волнует.
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 12.01.2009 в 11:48.
viter.alex вне форума Ответить с цитированием
Старый 12.01.2009, 11:38   #26
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

А вот так это все можно использовать:
Линии во всех строках и столбцах всех таблиц
Код:
Public Sub РисоватьЛинии()
  Dim wwt As New WorkWithTable
  Dim oRow As Row
  Dim oCol As Column
  Dim oTable As Table
  Dim i As Integer
  For Each oTable In ActiveDocument.Tables
    For Each oCol In oTable.Columns
      wwt.DrawVertLine oTable, oCol
    Next oCol
    For Each oRow In oTable.Rows
      wwt.DrawHorLine oTable, oRow
    Next oRow
  Next oTable
End Sub
Линии в нечетных столбцах и четных строках
Код:
Public Sub РисоватьЛинии()
  Dim wwt As New WorkWithTable
  Dim oRow As Row
  Dim oCol As Column
  Dim oTable As Table
  Dim i As Integer
  For Each oTable In ActiveDocument.Tables
    For i = 1 To oTable.Columns.Count Step 2
      wwt.DrawVertLine oTable, oTable.Columns(i)
    Next i
    For i = 2 To oTable.Rows.Count Step 2
      wwt.DrawHorLine oTable, oTable.Rows(i)
    Next i
    wwt.GroupLinesForTable oTable
  Next oTable
End Sub
И, что немаловажно, сетка перемещается вместе с таблицей, к которой она привязана.
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 12.01.2009 в 11:56. Причина: Дополнил
viter.alex вне форума Ответить с цитированием
Старый 12.01.2009, 21:28   #27
tolikman
Форумчанин
 
Регистрация: 25.08.2008
Сообщений: 159
По умолчанию

viter.alex огромное спасибо за такое количество выделенного времени для решения моего вопроса и за само грамотное решение!!!
tolikman вне форума Ответить с цитированием
Старый 12.01.2009, 21:35   #28
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

Цитата:
Сообщение от tolikman Посмотреть сообщение
viter.alex огромное спасибо за такое количество выделенного времени для решения моего вопроса и за само грамотное решение!!!
Пожалуйста. Кстати, чистого времени ушло часа 2–2,5. Дольше справку по Word читал.
Делал из спортивного интереса. Много нового узнал.
Кстати, милости прошу в мой блог, по изменению ленточного интерфейса и блог по макросам.
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 12.01.2009 в 21:40.
viter.alex вне форума Ответить с цитированием
Старый 12.01.2009, 21:50   #29
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию Ушёл в блог — там интереснее!

Уважаемый viter.alex, как скромно Вы намекнули на Ваш блог:-)
Почему-то в Сети обычно первым делом спешат пропиарить своё бесценное «дитё»! Но в Вашем случае это как раз вовремя и к месту.

Последний раз редактировалось Sasha_Smirnov; 12.01.2009 в 21:58.
Sasha_Smirnov вне форума Ответить с цитированием
Старый 12.01.2009, 21:51   #30
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию

viter.alex:
— Обязательно комментировать код, особенно если вы его передаете другому человеку.

Ух как этого не хватает на данном форуме!!!

Последний раз редактировалось Sasha_Smirnov; 12.01.2009 в 21:57.
Sasha_Smirnov вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Отправка SMS через клик по строке таблицы RUBEY Microsoft Office Excel 4 25.12.2008 11:07
Как нарисовать линию по пикселям DenLab Общие вопросы Delphi 4 03.12.2008 09:34
Как же нарисовать линию на форме? (Вопрос новичка) grey Помощь студентам 11 24.11.2008 10:31
хочу стереть линию с канвы.КАК? harmager Общие вопросы Delphi 1 24.11.2008 10:28