1

Тема: Новые свойства для класс Таблиц Word

В этой теме создан новый класс Таблицы Word  с новыми полезными свойствами и функциями.
По мере написания новых свойств буду добавлять их в этой теме.
Вот основные параметры нового класса clsMyTable

Public Table As Table ' Объект Таблица Word
Public LinesTables As Collection ' Коллекция строк таблицы
Public LinesTableInPage As Collection ' Коллекция строк таблицы по страницам

Private Sub Class_Initialize()
    Set LinesTables = New Collection
    Set LinesTableInPage = New Collection
End Sub

Public Property Get PageStart() As Long ' Номер первой страницы таблицы
    PageStart = Me.Table.Range.Characters.First.Information(wdActiveEndAdjustedPageNumber)
End Property

Public Property Get PageEnd() As Long ' Номер последней страницы таблицы
    PageEnd = Me.Table.Range.Characters.Last.Information(wdActiveEndAdjustedPageNumber)
End Property

Public Property Get PagesTable() As Collection ' Коллекция всех страниц таблицы
Dim i As Long
    Set PagesTable = New Collection
    For i = Me.PageStart To Me.PageEnd
        PagesTable.Add ActiveWindow.ActivePane.Pages(i), "Page_" & i
    Next i
End Property

Public Property Get PageCount() As Long ' Всего страниц занимаемых таблицей
    PageCount = Me.PagesTable.Count
End Property

Public Property Get LineStart() As Long ' Номер 1-й строки таблицы
    LineStart = Me.Table.Range.Characters.First.Information(wdFirstCharacterLineNumber)
End Property

Public Property Get LineEnd() As Long ' Номер последней строки таблицы
    LineEnd = Me.Table.Range.Characters.Last.Information(wdFirstCharacterLineNumber)
End Property

Public Property Get LinesCount() As Long ' Всего строк в таблице
Dim Page As Page, i As Long, j As Long
Dim colLine As Collection
    Select Case Me.PageCount
        Case 1
            Set Page = Me.PagesTable("Page_" & Me.PageStart)
            Set colLine = New Collection
                For i = Me.LineStart To Me.LineEnd
                    colLine.Add Page.Rectangles(1).Lines(i)
                Next i
                Set Me.LinesTables = colLine
                    LinesTableInPage.Add colLine, "Page_" & Me.PageStart
        Case Else
            For j = Me.PageStart To Me.PageEnd
                Set Page = Me.PagesTable("Page_" & Me.PageStart)
                    If j = Me.PageStart Then
                        Set colLine = New Collection
                        For i = Me.LineStart To Page.Rectangles(1).Lines.Count
                            colLine.Add Page.Rectangles(1).Lines(i)
                            Me.LinesTables.Add Page.Rectangles(1).Lines(i)
                        Next i
                    ElseIf j = Me.PageEnd Then
                        Set colLine = New Collection
                        For i = 1 To Me.LineEnd
                            colLine.Add Page.Rectangles(1).Lines(i)
                            Me.LinesTables.Add Page.Rectangles(1).Lines(i)
                        Next i
                    Else
                        Set colLine = New Collection
                        For i = 1 To Page.Rectangles(1).Lines.Count
                            colLine.Add Page.Rectangles(1).Lines(i)
                            Me.LinesTables.Add Page.Rectangles(1).Lines(i)
                        Next i
                    End If
                    Me.LinesTableInPage.Add colLine, "Page_" & j
            Next j
    End Select
    LinesCount = Me.LinesTables.Count
End Property

Public Property Get TableWidth() As Single ' Общая ширина таблицы в пунктах
Dim Wmax As Single, i As Long, Line As Line
    Set Line = Me.LinesTables(1)
    Wmax = Line.Width
    For i = 2 To Me.LinesTables.Count
        Set Line = Me.LinesTables(i)
            If Line.Width > Wmax Then
                Wmax = Line.Width
            End If
    Next i
    TableWidth = Wmax
End Property

Public Property Get TableHeight() As Single ' Общая высота таблицы в пунктах
Dim Hmax As Single, i As Long, Line As Line
Hmax = 0
    For i = 1 To Me.LinesTables.Count
        Set Line = Me.LinesTables(i)
        Hmax = Hmax + Line.Height
    Next i
    TableHeight = Hmax
End Property

2

Re: Новые свойства для класс Таблиц Word

Вот еще пара свойств класса

Public Property Get TableSquare() As Single  ' Общая площадь таблицы в пунктах
    TableSquare = Me.TableWidth * Me.TableHeight
End Property

Public Property Get TableParameters() As Collection ' Пареметры ширины высоты и площади каждого элемента таблицы на странице
Dim i As Long, Line As Line, col As Collection, j As Long
Dim ncol As Collection, h As Single, s As Single, lst(1 To 3) As Variant
    Set ncol = New Collection
    For i = Me.PageStart To Me.PageEnd
        Set col = Me.LinesTableInPage("Page_" & i)
            h = 0
            For j = 1 To col.Count
                Set Line = col(i)
                    h = h + Line.Height
            Next j
                lst(1) = Me.TableWidth
                lst(2) = h
                lst(3) = Me.TableWidth * h
        ncol.Add lst, "Page_" & i
    Next i
    Set TableParameters = ncol
End Property

3

Re: Новые свойства для класс Таблиц Word

подскажите и как эти выложенные Вами коды использовать? 1 й например как?

4

Re: Новые свойства для класс Таблиц Word

1. Откройте новый документ
2. Создайте таблицу, например 200 строк на 5 столбцов
3. В редакторе VBA выберете проект документа.
4. В проекте создайте новый класс и назовите его clsMyTable
5. Вставьте в него весь код из постов
6. В проекте документа в модуле ThisDocument создайте процедуру TestTable с таким кодом

Public Sub TestTable ()
Dim cls As clsMyTable
    Set cls = New clsMyTable
    Set cls.Table = Selection.Table(1)
End Sub

7. Выполните макрос построчно в редакторе VBA.
8. Set cls.Table = Selection.Table в окне Locas посмотрите свойства объекта cls

Отредактировано aap77 (09.06.2012 11:11:57)

5

Re: Новые свойства для класс Таблиц Word

такие телодвижения...
выделяет cls As clsMyTable Юзер дефинед нот дефинед, одним словом не объявлена, но класс clsMyTable есть

6

Re: Новые свойства для класс Таблиц Word

Небольшая ошибка в коде, вот исправленый

Public Sub TestTable ()
Dim cls As clsMyTable
    Set cls = New clsMyTable
    Set cls.Table = Selection.Table(1)
End Sub

7

Re: Новые свойства для класс Таблиц Word

та же ошибка на том же месте

8

Re: Новые свойства для класс Таблиц Word

Я считаю, что Вы не правы. Пишите мне в PM.

Позвольте размыть профессиональную пресность, профессиональным юмором smile

Муж с женой лежат в постели. Мужу хочется, он кладет руку на бедро жены. Жена: — Сегодня не могу. Мне завтра утром к гинекологу, надо быть чистой. Муж ворочается, никак не может заснуть — очень хочется. Трогает жену за плечо: — А к стоматологу тебе завтра не надо?

[url=http://стоматология-эстет.рф/]Стоматология в Перми[/url]

9

Re: Новые свойства для класс Таблиц Word

На этой аккаунтов  Instagram лайков  вывода представлен перечень агентств сообразно регистрации  раскрутки логотипов SMM в новгородской системе  продвижении Инстаграм массфолловинга. К сожалению,  раскрутки не хватает информации чтобы создания полной таксономии  вывода, только рекомендуется проверить содержание своего бизнеса в Новгороде Нижнем подписчиков из его каталога сообществ. Цель этой услуги в России составляет 60 миллионов каждый месяц массфолловинга. Большинство женщин. В Instagram вы можете связаться с серьезными людьми, возвращающимися едва ко всем студентам. Вконтакти по-прежнему остается популярной социальной сообществ  в России. Средняя аудитория Инстаграм - 15-25 лет   улучшения. Instagram расширяет Нижний Новгород до 95 миллионов пользователей Инстаграм. В прошлом году SMM  раскрутки смотрел телепередачи в течение дня и в течение нескольких месяцев лайков. SMM  улучшения службы чтобы предоставления преимуществ. Миллионы пользователей ежедневно получают доступ к своим аккаунтов  в социальных сетях Instagram. Около 100 000 компаний и сообществ  эффективно поддерживают продукты и услуги с через предметов коллекционирования, публикаций и знаний  раскрутки парикмахеры и дизайнеры
продвижение Инстаграм Нижний Новгород 
Инстаграм вы становиться одним из них  улучшения, только у вас есть навыки и социальные навыки аккаунтов  подписчиков? Следовать шесть сиречь более часов вы можете перевести свой бизнес архитекторы и стилисты для новый высота, получить бездна постоянных клиентов  продвижении, овладевать репутацию и получить весь знания, необходимые для увеличения продаж сам в социальных сетях. Для тех, который хочет помочь в создании, мобилизации лайков, развитии и  вывода основных социальных групп и групп блогеры. Работаем со студиями аккаунтов , гостиничными корпусами  вывода, студиями, кафе, ресторанами  продвижении, стадионами  раскрутки и салонами, блогеры, государственными учреждениями и крупными коммерческими центрами. Ваши подписчики будут обновлены, alias мы вернем вам деньги. Рабочая группа  вывода лайков имеет более 5 лет опыта работы в Нижнем Новгороде. Продвижение сообществ ! Ваше извещение будет казаться один выбранной вами аудитории  улучшения! Через два дня потом подписания нижегородским контрактом качество сетевого оборудования аккаунтов  сохраняется лайков Instagram.
заходите  внешняя ссылка  - Раскрутка бизнеса в инстаграм

https://insta-novgorod.ru