Vba word перебор всех таблиц

I am looking for a way (or decent introduction) into how to select every table in a Microsoft Word 2013 Document and autofit the contents. Each table is independent of one another and separated by text.

I have established the following code so far:

Sub autofit()

    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)

End Sub

Which works for individual tables and every column in said table, I understand the format of the «for loop», but would like a nudge to how to transform my individual selection to the entire document.

This is my first post so apologies for any conventions I have missed.

cheezsteak's user avatar

cheezsteak

2,6924 gold badges22 silver badges38 bronze badges

asked Dec 18, 2014 at 17:18

Cellobin22's user avatar

Its pretty trivial to loop them all;

Dim t As Table
For Each t In ActiveDocument.Tables
    t.AutoFitBehavior wdAutoFitContent
Next

answered Dec 18, 2014 at 17:22

Alex K.'s user avatar

Alex K.Alex K.

170k30 gold badges263 silver badges286 bronze badges

1

Страницы 1

Чтобы отправить ответ, вы должны войти или зарегистрироваться

1 22.08.2010 21:55:33

  • Саша
  • сержант
  • Неактивен
  • Зарегистрирован: 20.08.2010
  • Сообщений: 12

Тема: Макросы.Работа с таблицей в Worde

Ребята,нужна помощь!!!!У меня есть текстовый документ.В нем есть таблица,в которую мне нужно попасть и пройтись по всем столбцам и строчкам.Как мне это сделать?Можете напискать текст программы?

2 Ответ от andrkar 23.08.2010 14:59:02

  • andrkar
  • Модератор
  • Неактивен
  • Откуда: Томск
  • Зарегистрирован: 10.03.2010
  • Сообщений: 431
  • Поблагодарили: 26

Re: Макросы.Работа с таблицей в Worde

и толку от того, что вы пройдетесь по всем ячейкам? Нужно ведь еще какие-то действия сделать с этими ячейками, как я понимаю?

3 Ответ от Саша 23.08.2010 21:51:14

  • Саша
  • сержант
  • Неактивен
  • Зарегистрирован: 20.08.2010
  • Сообщений: 12

Re: Макросы.Работа с таблицей в Worde

да smile но прежде мне нужно попасть в таблицу….я не представляю как это сделать…ну и пробежаться по строкам и столбцам….что нужно дальше я уже спрошу потом smile

4 Ответ от viter.alex 24.08.2010 01:23:38

  • Макросы.Работа с таблицей в Worde
  • viter.alex
  • Модератор
  • Неактивен
  • Откуда: Харьков, Украина
  • Зарегистрирован: 21.12.2009
  • Сообщений: 884
  • Поблагодарили: 140

Re: Макросы.Работа с таблицей в Worde

Саша, дело в том, что вы представляете себе решение своей задачи как «пробежаться по строкам и столбцам», а на самом деле оно может быть совершенно иным. Например, можно воспользоваться поиском в таблице.
Ну да ладно, пробежаться можно так:

Sub RunThroughTable()
  Dim i As Long, j As Long 'Счётчики строк и столбцов
  Dim oTbl As Table 'Таблица, в которой будем перебирать ячейки
  
  Set oTbl = ActiveDocument.Tables(1) 'Первая таблица в документе
  For i = 1 To oTbl.Rows.Count 'Перебор всех строк
    For j = 1 To oTbl.Columns.Count 'Перебор всех столбцов
      Debug.Print "Строка " & i & "; Столбец " & j & ". Текст ячейки: " & oTbl.Cell(i, j).Range.Text
    Next j
  Next i
End Sub

Эта процедура «пробежится» по всем ячейкам первой таблицы в активном документе, перебирая строки и столбцы, и выведет номер строки, столбца и содержимое соответствующей ячейки. Вывод производится в Immediate Window, которое вызывается по Ctrl+G. Процедура не будет работать если в таблице есть объединённые ячейки. Если вы хотите «пробежаться» по таблице, в которой находится курсор, тогда замените ActiveDocument на Selection.
Второй способ перебора ячеек. Более быстрый и будет работать вне зависимости от наличия объединённых ячеек

Sub RunThroughTable2()
  Dim oCell As Cell 'Переменная, которой будем перебирать ячейки
  Dim oTbl As Table 'Таблица, в которой будем перебирать ячейки
  
  Set oTbl = ActiveDocument.Tables(1) 'Первая таблица в документе
  Set oCell = oTbl.Range.Cells(1) 'Первая ячейка в таблице
  
  Do Until oCell Is Nothing
    'Вывод информации о ячейке или любые другие действия
    Debug.Print "Строка " & oCell.RowIndex & "; Столбец " & oCell.ColumnIndex & ". Текст ячейки: " & oCell.Range.Text
    Set oCell = oCell.Next 'Переход к следующей ячейке
  Loop
End Sub

Предполагается, что мы имеем дело с обычной таблицей, не имеющей вложенных таблиц.

Тему переношу в раздел «Автоматизация»

Лучше день потерять — потом за пять минут долететь!

5 Ответ от Саша 24.08.2010 07:25:52

  • Саша
  • сержант
  • Неактивен
  • Зарегистрирован: 20.08.2010
  • Сообщений: 12

Re: Макросы.Работа с таблицей в Worde

Спасибо большое smile

Страницы 1

Чтобы отправить ответ, вы должны войти или зарегистрироваться

I have a 3 X 3 (say tableA) table in MS word.
The (2,2)th cell is a split cell(split into 2X2 table).
How can I cycle through all the cells in the tableA.

Dim strCellText As String
Dim uResp As String
Dim Row As Integer
Dim Col As Integer

Dim itable As Table


For Each itable In ThisDocument.Tables

    uResp = ""

    For Row = 1 To itable.Rows.Count

        For Col = 1 To itable.Columns.Count

            strCellText = itable.Cell(Row, Col).Range.Text
            uResp = uResp & Trim(strCellText)                

        Next

    Next

    MsgBox uResp
Next

This program gives a compilation error:

Run time error 5914
The requested member of the collection does not exist

How can I iterate though cells of a tables which has split cells.

Martijn Pieters's user avatar

asked Mar 23, 2013 at 9:39

Vinod's user avatar

3

You should assume that each of the row has the maximum possible number of columns. In your situation, that would be four. To iterate through each cell, I propose to set On Error Resume Next before the first loop starts. Then inside your inner loop, try this code:

strCellText = itable.cell(Row, Col).Range.Text

If Err.Number = 0 Then
    uResp = uResp & Trim(strCellText)
    Debug.Print Row, Col, strCellText
Else
    Err.Clear
End If

JSTL's user avatar

JSTL

8081 gold badge16 silver badges25 bronze badges

answered Mar 23, 2013 at 10:45

Kazimierz Jawor's user avatar

Kazimierz JaworKazimierz Jawor

18.8k7 gold badges35 silver badges55 bronze badges

4

If you want to go through all cells in all tables in a MS Word Document, even if the cells are merged, I got the results I wanted. Try this:

Sub CheckingInTheCell
Dim C as Cell
Dim tableCount, Ctr

tableCount = ActiveDocuments.tables.count

for Ctr = 1 to tableCount
   For each C in ActiveDocument.Tables(Ctr).Range.cells
       .....your validations or whatever you would like to do for the cell content
   next C
next Ctr

End Sub

JSTL's user avatar

JSTL

8081 gold badge16 silver badges25 bronze badges

answered Aug 22, 2018 at 17:49

Lav Zolovan Mehta's user avatar

1

I run into this situation when I am trying to extract data from (sometimes malformed) tables. This is how I handle it:

Check the number of columns

For each row in table.rows
  if row.cells.count < expectedRows
    'You know you are lacking rows
  else
    'Normal processing
  end if
Next

or Go through each cell if you want all the data anyway

For each row in table.rows
  For each cell in row.cells
    'Process individual cells
  Next
Next

None of those work if cells were merged vertically.

answered May 20, 2015 at 11:12

RSinohara's user avatar

RSinoharaRSinohara

6201 gold badge4 silver badges25 bronze badges

13 / 13 / 11

Регистрация: 03.09.2011

Сообщений: 1,026

1

29.03.2018, 05:37. Показов 3866. Ответов 5


Студворк — интернет-сервис помощи студентам

В общем, написал алгоритм перебора ячеек Cell.
Вроде, все хорошо.
Однако, проблема с объедененными ячейками:

Как я могу понять при переборе, что я работаю с объеденной ячейкой и что я должен позаимствовать значение сверху?
Ну например, что текущая обрабатываемая ячейка относится к такой то группе=> заимствовать значение оттуда-то.

Цель всего этого- затолкать в таблицу Access.

Миниатюры

Парсинг таблиц WORD
 



0



141 / 119 / 29

Регистрация: 12.02.2017

Сообщений: 308

30.03.2018, 11:08

2

Посмотрите в справке свойства MergeArea & MergeCells объекта Range.



0



Аксима

6076 / 1320 / 195

Регистрация: 12.12.2012

Сообщений: 1,023

30.03.2018, 12:54

3

Здравствуйте, iluxa1810,

На данный момент мне в голову приходят следующие варианты решения вашей проблемы:

Вариант первый: при переборе ячеек таблицы Word перехватить ошибку и обратиться к последней успешно полученной ячейке выше.

Вариант второй: скопировать таблицу Word на лист Excel и дальше использовать подход, предложенный Homarty.

Ниже прилагаю код для обоих вариантов.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Parse()
    Dim doc As Document, tbl As Table, c As Cell
    Dim successfullyGot() As Cell
    Dim i As Long, j As Long
    Set doc = ThisDocument
    Set tbl = doc.Tables(1)
    ReDim successfullyGot(1 To tbl.Columns.Count) As Cell
    For i = 1 To tbl.Rows.Count
        For j = 1 To tbl.Columns.Count
            On Error Resume Next
            Set c = tbl.Cell(i, j)
            If Err.Number Then Set c = successfullyGot(j) Else Set successfullyGot(j) = c
            On Error GoTo 0
            Debug.Print Left(c.Range.Text, Len(c.Range.Text) - 2) & " ";
        Next
        Debug.Print
    Next
End Sub
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub ParseInExcel()
    Dim doc As Document, tbl As Table, eObj, eWbk, eWst, eRng, eCell
    Dim i As Long, j As Long
    Set doc = ThisDocument
    Set tbl = doc.Tables(1)
    tbl.Range.Copy
    Set eObj = CreateObject("Excel.Application")
    Set eWbk = eObj.Workbooks.Add
    Set eWst = eWbk.Sheets(1)
    eWst.Paste
    Set eRng = eWst.Cells(1).CurrentRegion
    For i = 1 To eRng.Rows.Count
        For j = 1 To eRng.Columns.Count
            Set eCell = eRng.Cells(i, j)
            If eCell.MergeCells Then
                Debug.Print eCell.MergeArea.Cells(1).Value & " ";
            Else
                Debug.Print eCell.Value & " ";
            End If
        Next
        Debug.Print
    Next
    eWbk.Saved = True
    eWbk.Close
    Set eWbk = Nothing
    eObj.Quit
    Set eObj = Nothing
End Sub

С уважением,

Аксима



1



13 / 13 / 11

Регистрация: 03.09.2011

Сообщений: 1,026

31.03.2018, 11:11

 [ТС]

4

Цитата
Сообщение от Аксима
Посмотреть сообщение

На данный момент мне в голову приходят следующие варианты решения вашей проблемы:
Вариант первый: при переборе ячеек таблицы Word перехватить ошибку и обратиться к последней успешно полученной ячейке выше.
Вариант второй: скопировать таблицу Word на лист Excel и дальше использовать подход, предложенный Homarty.

Спасибо.
А сработает ли первый вариант для объеденных столбцов? Смогу ли я однозначно понять, что вот эта объедененная ячейка на самом деле = двум ячейкам из предыдущей строчки?

Миниатюры

Парсинг таблиц WORD
 



0



6076 / 1320 / 195

Регистрация: 12.12.2012

Сообщений: 1,023

31.03.2018, 15:08

5

Здравствуйте, iluxa1810,

Первый вариант рассчитан на пример, выложенный вами в первом посте.
На случай, если нужно обрабатывать более сложные таблицы, я подготовил более сложный вариант (второй).
И, кстати, вместо того чтобы спрашивать «А сработает ли?», можно просто запустить макрос и посмотреть, сработает ли он .

С уважением,

Аксима



0



13 / 13 / 11

Регистрация: 03.09.2011

Сообщений: 1,026

01.04.2018, 19:23

 [ТС]

6

Цитата
Сообщение от Аксима
Посмотреть сообщение

Первый вариант рассчитан на пример, выложенный вами в первом посте.
На случай, если нужно обрабатывать более сложные таблицы, я подготовил более сложный вариант (второй).
И, кстати, вместо того чтобы спрашивать «А сработает ли?», можно просто запустить макрос и посмотреть, сработает ли он .

Попробую поиграться.
Странно, что у Word’a отсутствует понятие объединенных ячеек.
Если из ворда можно скопипастить таблицу в Excel, и он замержит корректно все, то все таки что-то должно быть.

Добавлено через 22 часа 38 минут

Цитата
Сообщение от Аксима
Посмотреть сообщение

tbl.Range.Copy

и

Цитата
Сообщение от Аксима
Посмотреть сообщение

eWst.Paste

Нельзя никак?

Получается, что я во время работы модуля не смогу ничего копипастить…

Добавлено через 10 минут
Странно то, что если все копипастится так, что в Excel начинают работать свойства,которые показывают что и с чем было объеденено, то значит имеется какой-то алгоритм, по которому все это вычисляется.



0



Add Table to Word Document

This simple macro will add a table to your Word document:

Sub VerySimpleTableAdd()
    Dim oTable As Table
    Set oTable = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=3, NumColumns:=3)
End Sub

Select Table in Word

This macro will select the first table in the active Word document:

Sub SelectTable()
'selects first table in active doc
    If ActiveDocument.Tables.Count > 0 Then    'to avoid errors we check if any table exists in active doc
        ActiveDocument.Tables(1).Select
    End If
End Sub

Loop Through all Cells in a Table

This VBA macro will loop through all cells in a table, writing the cell count to the cell:

Sub TableCycling()
' loop through all cells in table
    Dim nCounter As Long    ' this will be writen in all table cells
    Dim oTable As Table
    Dim oRow As Row
    Dim oCell As Cell

    ActiveDocument.Range.InsertParagraphAfter    'just makes new para athe end of doc, Table will be created here
    Set oTable = ActiveDocument.Tables.Add(Range:=ActiveDocument.Paragraphs.Last.Range, NumRows:=3, NumColumns:=3)    'create table and asign it to variable
    For Each oRow In oTable.Rows    ' outher loop goes through rows
        For Each oCell In oRow.Cells    'inner loop goes
            nCounter = nCounter + 1    'increases the counter
            oCell.Range.Text = nCounter    'writes counter to the cell
        Next oCell
    Next oRow

    'display result from cell from second column in second row
    Dim strTemp As String
    strTemp = oTable.Cell(2, 2).Range.Text
    MsgBox strTemp
End Sub

Create Word Table From Excel File

This VBA example will make a table from an Excel file:

Sub MakeTablefromExcelFile()
'advanced
    Dim oExcelApp, oExcelWorkbook, oExcelWorksheet, oExcelRange
    Dim nNumOfRows As Long
    Dim nNumOfCols As Long
    Dim strFile As String

    Dim oTable As Table    'word table
    Dim oRow As Row    'word row
    Dim oCell As Cell    'word table cell
    Dim x As Long, y As Long    'counter for loops

    strFile = "c:UsersNenadDesktopBookSample.xlsx"    'change to actual path
    Set oExcelApp = CreateObject("Excel.Application")
    oExcelApp.Visible = True
    Set oExcelWorkbook = oExcelApp.Workbooks.Open(strFile)    'open workbook and asign it to variable
    Set oExcelWorksheet = oExcelWorkbook.Worksheets(1)    'asign first worksheet to variable
    Set oExcelRange = oExcelWorksheet.Range("A1:C8")
    nNumOfRows = oExcelRange.Rows.Count
    nNumOfCols = oExcelRange.Columns.Count

    ActiveDocument.Range.InsertParagraphAfter    'just makes new para athe end of doc, Table will be created here
    Set oTable = ActiveDocument.Tables.Add(Range:=ActiveDocument.Paragraphs.Last.Range, NumRows:=nNumOfRows, NumColumns:=nNumOfCols)    'create table and asign it to variable
    '***real deal, table gets filled here
    For x = 1 To nNumOfRows
        For y = 1 To nNumOfCols
            oTable.Cell(x, y).Range.Text = oExcelRange.Cells(x, y).Value
        Next y
    Next x
    '***
    oExcelWorkbook.Close False
    oExcelApp.Quit
    With oTable.Rows(1).Range    'we can now apply some beautiness to our table :)
        .Shading.Texture = wdTextureNone
        .Shading.ForegroundPatternColor = wdColorAutomatic
        .Shading.BackgroundPatternColor = wdColorYellow
    End With
End Sub

Like this post? Please share to your friends:
  • Vba word открытых документов
  • Vba word отключить сообщения
  • Vba word отключить обновление экрана
  • Vba word определить абзац
  • Vba word объектная модель