Vba word таблица в таблице

Gogic
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 120
Зарегистрирован: 24.08.2008 (Вс) 13:19

Word VBA Таблица=Ячейка другой таблицы?

Уважаемые, у меня возник такой вопрос.

Есть таблица NxM.

Так вот, возможно ли работать с каждой ячейкой этой таблицы, как с отдельной таблицей? (Объект Table)


Gogic
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 120
Зарегистрирован: 24.08.2008 (Вс) 13:19

Re: Word VBA Таблица=Ячейка другой таблицы?

Сообщение Gogic » 03.04.2013 (Ср) 11:07

Ответ найден, закрывайте топ.

Код: Выделить всё
Set microRange = mTable.Cell(1, 1).Range
Set microTable = microRange.Tables.Add(Range:=microRange, NumRows:=2, NumColumns:=4)


Gogic
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 120
Зарегистрирован: 24.08.2008 (Вс) 13:19

Re: Word VBA Таблица=Ячейка другой таблицы?

Сообщение Gogic » 03.04.2013 (Ср) 11:51

Хотя нет, не закрывайте. Таблицу вставляет, но количество строк в ней всегда 1 (что бы не было задано).


Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 03.04.2013 (Ср) 15:00

Так — работает:

Код: Выделить всё
Sub DoIt()
    Dim Tbl As Table
    Set Tbl = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=4, NumColumns:= _
        4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed)

        Tbl.Cell(2, 1).Select
    Selection.Move

    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
        3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
End Sub

Обрати внимание на вызов Selection.Move, без него вставляется таблица из одной строки.


Gogic
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 120
Зарегистрирован: 24.08.2008 (Вс) 13:19

Re: Word VBA Таблица=Ячейка другой таблицы?

Сообщение Gogic » 06.04.2013 (Сб) 19:08

Спасибо. От себя замечу, что .Move переводит в правую ячейку от текущей, .MoveLeft — сохраняет текущую ячейку, .MoveRight — переводит в правую, т.е по сути работает как .Move.


Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2753
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 06.04.2013 (Сб) 21:19

Gogic писал(а):От себя замечу, что .Move переводит в правую ячейку от текущей

Хм.. Не заметил, когда экспериментировал. А что если задать величину перемещения 0?



Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1

Создание таблиц в документе Word из кода VBA Excel. Метод Tables.Add, его синтаксис и параметры. Объекты Table, Column, Row, Cell. Границы таблиц и стили.

Работа с Word из кода VBA Excel
Часть 4. Создание таблиц в документе Word
[Часть 1] [Часть 2] [Часть 3] [Часть 4] [Часть 5] [Часть 6]

Таблицы в VBA Word принадлежат коллекции Tables, которая предусмотрена для объектов Document, Selection и Range. Новая таблица создается с помощью метода Tables.Add.

Синтаксис метода Tables.Add

Expression.Add (Range, Rows, Columns, DefaultTableBehavior, AutoFitBehavior)

Expression – выражение, возвращающее коллекцию Tables.

Параметры метода Tables.Add

  • Range – диапазон, в котором будет создана таблица (обязательный параметр).
  • Rows – количество строк в создаваемой таблице (обязательный параметр).
  • Columns – количество столбцов в создаваемой таблице (обязательный параметр).
  • DefaultTableBehavior – включает и отключает автоподбор ширины ячеек в соответствии с их содержимым (необязательный параметр).
  • AutoFitBehavior – определяет правила автоподбора размера таблицы в документе Word (необязательный параметр).

Создание таблицы в документе

Создание таблицы из 3 строк и 4 столбцов в документе myDocument без содержимого и присвоение ссылки на нее переменной myTable:

With myDocument

Set myTable = .Tables.Add(.Range(Start:=0, End:=0), 3, 4)

End With

Создание таблицы из 5 строк и 4 столбцов в документе Word с содержимым:

With myDocument

myInt = .Range.Characters.Count 1

Set myTable = .Tables.Add(.Range(Start:=myInt, End:=myInt), 5, 4)

End With

Для указания точки вставки таблицы присваиваем числовой переменной количество символов в документе минус один. Вычитаем единицу, чтобы исключить из подсчета последний знак завершения абзаца (¶), так как точка вставки не может располагаться за ним.

Последний знак завершения абзаца всегда присутствует в документе Word, в том числе и в новом без содержимого, поэтому такой код подойдет и для пустого документа.

При создании, каждой новой таблице в документе присваивается индекс, по которому к ней можно обращаться:

myDocument.Tables(индекс)

Нумерация индексов начинается с единицы.

Отображение границ таблицы

Новая таблица в документе Word из кода VBA Excel создается без границ. Отобразить их можно несколькими способами:

Вариант 1
Присвоение таблице стиля, отображающего все границы:

myTable.Style = «Сетка таблицы»

Вариант 2
Отображение внешних и внутренних границ в таблице:

With myTable

.Borders.OutsideLineStyle = wdLineStyleSingle

.Borders.InsideLineStyle = wdLineStyleSingle

End With

Вариант 3
Отображение всех границ в таблице по отдельности:

With myTable

.Borders(wdBorderHorizontal) = True

.Borders(wdBorderVertical) = True

.Borders(wdBorderTop) = True

.Borders(wdBorderLeft) = True

.Borders(wdBorderRight) = True

.Borders(wdBorderBottom) = True

End With

Присвоение таблицам стилей

Вариант 1

myTable.Style = «Таблица простая 5»

Чтобы узнать название нужного стиля, в списке стилей конструктора таблиц наведите на него указатель мыши. Название отобразится в подсказке. Кроме того, можно записать макрос с присвоением таблице стиля и взять название из него.

Вариант 2

myTable.AutoFormat wdTableFormatClassic1

Выбирайте нужную константу с помощью листа подсказок свойств и методов – Auto List Members.

Обращение к ячейкам таблицы

Обращение к ячейкам второй таблицы myTable2 в документе myDocument по индексам строк и столбцов:

myTable2.Cell(nRow, nColumn)

myDocument.Tables(2).Cell(nRow, nColumn)

  • nRow – номер строки;
  • nColumn – номер столбца.

Обращение к ячейкам таблицы myTable в документе Word с помощью свойства Cell объектов Row и Column и запись в них текста:

myTable.Rows(2).Cells(2).Range = _

«Содержимое ячейки во 2 строке 2 столбца»

myTable.Columns(3).Cells(1).Range = _

«Содержимое ячейки в 1 строке 3 столбца»

В таблице myTable должно быть как минимум 2 строки и 3 столбца.

Примеры создания таблиц Word

Пример 1
Создание таблицы в новом документе Word со сплошными наружными границами и пунктирными внутри:

Sub Primer1()

Dim myWord As New Word.Application, _

myDocument As Word.Document, myTable As Word.Table

  Set myDocument = myWord.Documents.Add

  myWord.Visible = True

With myDocument

  Set myTable = .Tables.Add(.Range(0, 0), 5, 4)

End With

With myTable

  .Borders.OutsideLineStyle = wdLineStyleSingle

  .Borders.InsideLineStyle = wdLineStyleDot

End With

End Sub

В выражении myDocument.Range(Start:=0, End:=0) ключевые слова Start и End можно не указывать – myDocument.Range(0, 0).

Пример 2
Создание таблицы под ранее вставленным заголовком, заполнение ячеек таблицы и применение автосуммы:

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

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

Sub Primer2()

On Error GoTo Instr

Dim myWord As New Word.Application, _

myDocument As Word.Document, _

myTable As Word.Table, myInt As Integer

  Set myDocument = myWord.Documents.Add

  myWord.Visible = True

With myDocument

‘Вставляем заголовок таблицы

  .Range.InsertAfter «Продажи фруктов в 2019 году» & vbCr

  myInt = .Range.Characters.Count 1

‘Присваиваем заголовку стиль

  .Range(0, myInt).Style = «Заголовок 1»

‘Создаем таблицу

  Set myTable = .Tables.Add(.Range(myInt, myInt), 4, 4)

End With

With myTable

‘Отображаем сетку таблицы

  .Borders.OutsideLineStyle = wdLineStyleSingle

  .Borders.InsideLineStyle = wdLineStyleSingle

‘Форматируем первую и четвертую строки

  .Rows(1).Range.Bold = True

  .Rows(4).Range.Bold = True

‘Заполняем первый столбец

  .Columns(1).Cells(1).Range = «Наименование»

  .Columns(1).Cells(2).Range = «1 квартал»

  .Columns(1).Cells(3).Range = «2 квартал»

  .Columns(1).Cells(4).Range = «Итого»

‘Заполняем второй столбец

  .Columns(2).Cells(1).Range = «Бананы»

  .Columns(2).Cells(2).Range = «550»

  .Columns(2).Cells(3).Range = «490»

  .Columns(2).Cells(4).AutoSum

‘Заполняем третий столбец

  .Columns(3).Cells(1).Range = «Лимоны»

  .Columns(3).Cells(2).Range = «280»

  .Columns(3).Cells(3).Range = «310»

  .Columns(3).Cells(4).AutoSum

‘Заполняем четвертый столбец

  .Columns(4).Cells(1).Range = «Яблоки»

  .Columns(4).Cells(2).Range = «630»

  .Columns(4).Cells(3).Range = «620»

  .Columns(4).Cells(4).AutoSum

End With

‘Освобождаем переменные

Set myDocument = Nothing

Set myWord = Nothing

‘Завершаем процедуру

Exit Sub

‘Обработка ошибок

Instr:

If Err.Description <> «» Then

  MsgBox «Произошла ошибка: « & Err.Description

End If

If Not myWord Is Nothing Then

  myWord.Quit

  Set myDocument = Nothing

  Set myWord = Nothing

End If

End Sub

Метод AutoSum суммирует значения в ячейках одного столбца над ячейкой с суммой. При использовании его для сложения значений ячеек в одной строке, результат может быть непредсказуемым.

Чтобы просуммировать значения в строке слева от ячейки с суммой, используйте метод Formula объекта Cell:

myTable.Cell(2, 4).Formula («=SUM(LEFT)»)

Другие значения метода Formula, применяемые для суммирования значений ячеек:

  • «=SUM(ABOVE)» – сумма значений над ячейкой (аналог метода AutoSum);
  • «=SUM(BELOW)» – сумма значений под ячейкой;
  • «=SUM(RIGHT)» – сумма значений справа от ячейки.


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
title ms.prod ms.assetid ms.date ms.localizationpriority

Working with tables

word

cf0858b7-6b39-4c90-552e-edb695b5cda3

06/08/2019

medium

This topic includes Visual Basic examples related to the tasks identified in the following sections.

Creating a table, inserting text, and applying formatting

The following example inserts a four-column, three-row table at the beginning of the active document. The For Each…Next structure is used to step through each cell in the table. Within the For Each…Next structure, the InsertAfter method of the Range object is used to add text to the table cells (Cell 1, Cell 2, and so on).

Sub CreateNewTable() 
 Dim docActive As Document 
 Dim tblNew As Table 
 Dim celTable As Cell 
 Dim intCount As Integer 
 
 Set docActive = ActiveDocument 
 Set tblNew = docActive.Tables.Add( _ 
 Range:=docActive.Range(Start:=0, End:=0), NumRows:=3, _ 
 NumColumns:=4) 
 intCount = 1 
 
 For Each celTable In tblNew.Range.Cells 
  celTable.Range.InsertAfter "Cell " & intCount 
  intCount = intCount + 1 
 Next celTable 
 
 tblNew.AutoFormat Format:=wdTableFormatColorful2, _ 
 ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True 
End Sub

Inserting text into a table cell

The following example inserts text into the first cell of the first table in the active document. The Cell method returns a single Cell object. The Range property returns a Range object. The Delete method is used to delete the existing text and the InsertAfter method inserts the «Cell 1,1» text.

Sub InsertTextInCell() 
 If ActiveDocument.Tables.Count >= 1 Then 
  With ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range 
   .Delete 
   .InsertAfter Text:="Cell 1,1" 
  End With 
 End If 
End Sub

Returning text from a table cell without returning the end of cell marker

The following example returns and displays the contents of each cell in the first row of the first document table.

Sub ReturnTableText() 
 Dim tblOne As Table 
 Dim celTable As Cell 
 Dim rngTable As Range 
 
 Set tblOne = ActiveDocument.Tables(1) 
 For Each celTable In tblOne.Rows(1).Cells 
  Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _ 
  End:=celTable.Range.End - 1) 
  MsgBox rngTable.Text 
 Next celTable 
End Sub
Sub ReturnCellText() 
 Dim tblOne As Table 
 Dim celTable As Cell 
 Dim rngTable As Range 
 
 Set tblOne = ActiveDocument.Tables(1) 
 For Each celTable In tblOne.Rows(1).Cells 
  Set rngTable = celTable.Range 
  rngTable.MoveEnd Unit:=wdCharacter, Count:=-1 
  MsgBox rngTable.Text 
 Next celTable 
End Sub

Converting existing text to a table

The following example inserts tab-delimited text at the beginning of the active document and then converts the text to a table.

Sub ConvertExistingText() 
 With Documents.Add.Content 
  .InsertBefore "one" & vbTab & "two" & vbTab & "three" & vbCr 
  .ConvertToTable Separator:=Chr(9), NumRows:=1, NumColumns:=3 
 End With 
End Sub

Returning the contents of each table cell

The following example defines an array equal to the number of cells in the first document table (assuming Option Base 1). The For Each…Next structure is used to return the contents of each table cell and assign the text to the corresponding array element.

Sub ReturnCellContentsToArray() 
 Dim intCells As Integer 
 Dim celTable As Cell 
 Dim strCells() As String 
 Dim intCount As Integer 
 Dim rngText As Range 
 
 If ActiveDocument.Tables.Count >= 1 Then 
  With ActiveDocument.Tables(1).Range 
   intCells = .Cells.Count 
   ReDim strCells(intCells) 
   intCount = 1 
   For Each celTable In .Cells 
    Set rngText = celTable.Range 
    rngText.MoveEnd Unit:=wdCharacter, Count:=-1 
    strCells(intCount) = rngText 
    intCount = intCount + 1 
   Next celTable 
  End With 
 End If 
End Sub

Copying all tables in the active document into a new document

This example copies the tables from the current document into a new document.

Sub CopyTablesToNewDoc() 
 Dim docOld As Document 
 Dim rngDoc As Range 
 Dim tblDoc As Table 
 
 If ActiveDocument.Tables.Count >= 1 Then 
  Set docOld = ActiveDocument 
  Set rngDoc = Documents.Add.Range(Start:=0, End:=0) 
  For Each tblDoc In docOld.Tables 
   tblDoc.Range.Copy 
   With rngDoc 
    .Paste 
    .Collapse Direction:=wdCollapseEnd 
    .InsertParagraphAfter 
    .Collapse Direction:=wdCollapseEnd 
   End With 
  Next 
 End If 
End Sub

[!includeSupport and feedback]

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

Silvermatic

3 / 3 / 0

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

Сообщений: 36

1

09.03.2014, 19:01. Показов 20901. Ответов 16

Метки нет (Все метки)


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

Уже третий день не могу вникнуть в VBA в Word при работе с таблицами. Контрольная подвисла, время начинает поджимать, но нужно разобраться, а не банально копипастом все делать.

Задание вкратце:
В документе ворда есть таблица в ячейках которой содержится что угодно. Нужно макросом прошустрить выделенные клетки (по-умолчанию область прямоугольная), обработать только ячейки в которых содержатся цифры. Для каждого столбца необходимо вычислить среднее значение. Все средние значения вывести в строке, вставленной ниже выделенной области в соответствующих столбцах.

Что сделано на данный момент:

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
Sub NewRowWithResults()
Dim xxx As Column
Dim yyy As Cell
Dim sum As Integer
Dim cnt As Integer
 
 
For Each xxx In Selection.Range.Columns
    sum = 0
    cnt = 0
    For Each yyy In xxx.Cells
        If IsNumeric(yyy.Range.Text) Then
            sum = sum + yyy.Range.Text
            cnt = cnt + 1
        End If
    Next yyy
    ActiveDocument.Tables(1).Cell(1, 9).Range = sum
    ActiveDocument.Tables(1).Cell(1, 10).Range = cnt
Next xxx
 
'ActiveDocument.Tables(1).Cell(1, 9).Range = sum
'ActiveDocument.Tables(1).Cell(1, 10).Range = cnt
'Selection.InsertRowsBelow 1
End Sub

В данном примере выделаю 1 столбец и запускаю макрос. Проблема в том, что sum = 0 и cnt = 0 тоже.
Судя по продолжительности моргания выделенной области, могу предположить, что макрос перебирает все ячейки таблицы, а не только выделенного региона.

Прошу вашей помощи.



0



15136 / 6410 / 1730

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

Сообщений: 9,999

09.03.2014, 19:26

2

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

Проблема в том, что sum = 0 и cnt = 0 тоже

Текст ячейки всегда содержит в конце 2 символа chr(13)+chr(7), поэтому IsNumeric(yyy.Range.Text) всегда False.
Поскольку «нужно разобраться» , решение приводить не буду.

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

могу предположить, что макрос перебирает все ячейки таблицы

Чтобы не гадать, поставьте в цикл yyy.select и пройдите по шагам — F8.



0



Sasha_Smirnov

5561 / 1367 / 150

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

Сообщений: 4,107

Записей в блоге: 30

09.03.2014, 20:58

3

Лучший ответ Сообщение было отмечено как решение

Решение

Поэкспериментировав в окне Immediate, пока сделал такой вот набросок:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'Здесь надо выделить область в таблице Word
 
Sub AverageOfSelectedColumn()
Dim x1, x2, y1, y2
''вставка таблицы X на Y
'ActiveDocument.Tables.Add Selection.Range, 5, 5
 
    'координаты выделения
    x1 = Selection.Columns.First.Index
    x2 = Selection.Columns.Last.Index
    y1 = Selection.Rows.First.Index
    y2 = Selection.Rows.Last.Index
    
    Selection.Rows.Last.Range.Rows.Add 'добавление строки под выделением
    
    ActiveDocument.Tables(1).Cell(y2 + 1, x1).Formula "=Average(above)"
End Sub

Миниатюры

VBA в Word. Обработать ячейки таблицы, в которых содержатся цифры
 



1



Silvermatic

3 / 3 / 0

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

Сообщений: 36

09.03.2014, 21:06

 [ТС]

4

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

Текст ячейки всегда содержит в конце 2 символа chr(13)+chr(7), поэтому IsNumeric(yyy.Range.Text) всегда False.
Поскольку «нужно разобраться» , решение приводить не буду.

yyy.Range.Text преобразовать и перенести в массив чаров, определить длину и затереть 2 последних символа?

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

Чтобы не гадать, поставьте в цикл yyy.select и пройдите по шагам — F8.

Как и подозревал, проходит по всей таблице…
Тут трабла даже в другом. Изначально пробовал определить границы выделенной области таким способом:

Visual Basic
1
2
3
4
5
6
7
8
9
10
dim cb as integer ' column - begin
dim ce as integer ' column - end
dim rb as integer ' row - begin
dim re as integer ' row - end
 
cb = Selection.Range.FirstColumn
ce = Selection.Range.Columns.Count
 
rb = Selection.Range.FirstRow
re = Selection.Range.Rows.Count

Со строками все определялось нормально, а со столбцами не проходило — значения были от 1(cb) до 10(ce), т.е. прорабатывали все столбцы таблицы, а не те что были выделены.



0



Sasha_Smirnov

5561 / 1367 / 150

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

Сообщений: 4,107

Записей в блоге: 30

09.03.2014, 21:12

5

Вот наиболее близкий к заданию код. По крайней мере — по координатам выделения.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub AveragesOfSelectedColumns()
Dim x1, x2, y1, y2, j
    'координаты выделения
    x1 = Selection.Columns.First.Index
    x2 = Selection.Columns.Last.Index
    y1 = Selection.Rows.First.Index
    y2 = Selection.Rows.Last.Index
    
    Selection.Rows.Last.Range.Rows.Add 'добавление строки под выделением
    
    For j = x1 To x2
        ActiveDocument.Tables(1).Cell(y2 + 1, j).Formula _
        "=sum(above)" & "/" & y2 - y1 + 1
    Next
End Sub

Поле {=sum(above)}*, конечно, суммирует всё, что сверху — ну это так, просто демо.
___________________
* в таблице его код (после прогона данного примера) можно посмотреть по Alt-F9



2



Silvermatic

3 / 3 / 0

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

Сообщений: 36

09.03.2014, 21:19

 [ТС]

6

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

Вот наиболее близкий к заданию код. По крайней мере — по координатам выделения.

Я уже опробовал ваш код.
Границы выделенной области определяются устойчиво.

Вопрос по вставке строки под выделенной областью. Такой вариант чем-нибудь плох?

Visual Basic
1
Selection.InsertRowsBelow 1

Он нормально работает, но вдруг есть тонкости…



0



Казанский

15136 / 6410 / 1730

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

Сообщений: 9,999

09.03.2014, 21:37

7

Мой вариант

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub bb()
Dim c As Cell, col1&, col2&
With Selection
  If Not .Information(wdWithInTable) Then
    MsgBox "Выделение не в таблице!", vbCritical
    Exit Sub
  End If
  col1 = .Cells(1).ColumnIndex
  col2 = .Cells(.Cells.Count).ColumnIndex
  ReDim sum(col1 To col2)
  For Each c In .Cells
    sum(c.ColumnIndex) = sum(c.ColumnIndex) + Val(c.Range.Text)
  Next
  With .Rows.Last.Range.Rows.Add 'Sasha_Smirnov
    For col1 = col1 To col2
      .Cells(col1).Range = sum(col1)
    Next
  End With
End With
End Sub

Добавлено через 8 минут
Чтобы работало с любым десятичным разделителем, строка 12

Visual Basic
1
    sum(c.ColumnIndex) = sum(c.ColumnIndex) + Val(Replace(c.Range.Text, ",", "."))



2



3 / 3 / 0

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

Сообщений: 36

09.03.2014, 21:43

 [ТС]

8

Казанский, твой вариант «прожует» ячейки в которых содержится текст или пустые ячейки?

По большому счету осталось определить что в ячейке находится именно число, а не что-либо другое.



0



15136 / 6410 / 1730

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

Сообщений: 9,999

09.03.2014, 21:49

9

Silvermatic, попробуй!
И поставь курсор в слово Val, нажми F1.



1



3 / 3 / 0

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

Сообщений: 36

09.03.2014, 23:53

 [ТС]

10

Казанский, хоть и не совсем то, что нужно, но в таком виде будет достаточно съедобно, ибо лекций VBA не прочитали и 40%.
Благодарствую.



0



Sasha_Smirnov

5561 / 1367 / 150

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

Сообщений: 4,107

Записей в блоге: 30

10.03.2014, 00:11

11

Добил-таки свой эксселеподобный (с формулами) вариант. Разделитель дробей запятая.

Действует лишь на 1-ю таблицу в документе.

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
Option Explicit
 
'здесь надо выделить область в таблице Word
 
Sub AveragesOfColumnsOfSelection()
Dim x1, x2, y1, y2, j
'выход при отсутствии Таблицы 1 и при выделении вне её
If ActiveDocument.Tables.Count = 0 Then Exit Sub
If Not Selection.InRange(ActiveDocument.Tables(1).Range) Then Exit Sub
 
    'координаты выделения
    x1 = Selection.Columns.First.Index
    x2 = Selection.Columns.Last.Index
    y1 = Selection.Rows.First.Index
    y2 = Selection.Rows.Last.Index
    
    Selection.Rows.Last.Range.Rows.Add 'добавление строки под выделением
    
    'перевод номера колонки (1, 2, 3, 4, …) в вид: a, b, c, d, … [не пригодился!]
    
    For j = 64 + x1 To 64 + x2                              'код буквы A = 64 + 1
        ActiveDocument.Tables(1).Cell(y2 + 1, j - 64).Formula _
        "=sum([" & Chr(j) & y1 & ":" & Chr(j) & y2 & "])" & "/" & y2 - y1 + 1
    Next
'в документе, если видны не вычисленные значения, а коды, надо нажать Alt-F9
End Sub

Миниатюры

VBA в Word. Обработать ячейки таблицы, в которых содержатся цифры
 



0



Казанский

15136 / 6410 / 1730

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

Сообщений: 9,999

10.03.2014, 00:13

12

А, там же среднее надо было. Тогда так

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
Sub bb()
Dim c As Cell, col1&, col2&, ci&, ct$
With Selection
  If Not .Information(wdWithInTable) Then
    MsgBox "Выделение не в таблице!", vbCritical
    Exit Sub
  End If
  col1 = .Cells(1).ColumnIndex
  col2 = .Cells(.Cells.Count).ColumnIndex
  ReDim sum(col1 To col2), cnt(col1 To col2)
  For Each c In .Cells
    ct = c.Range.Text
    ct = Left$(ct, Len(ct) - 2)
    If IsNumeric(ct) Then
      ci = c.ColumnIndex
      sum(ci) = sum(ci) + CDbl(ct)
      cnt(ci) = cnt(ci) + 1
    End If
  Next
  With .Rows.Last.Range.Rows.Add 'Sasha_Smirnov
    For col1 = col1 To col2
      If cnt(col1) > 0 Then .Cells(col1).Range = sum(col1) / cnt(col1)
    Next
  End With
End With
End Sub



1



3 / 3 / 0

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

Сообщений: 36

10.03.2014, 11:04

 [ТС]

13

Спасибо за помощь, ребята. В коде разобрался, сделал на свой манер, все работает.

п.с. Сдать и забыть как страшный сон…



0



5561 / 1367 / 150

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

Сообщений: 4,107

Записей в блоге: 30

10.03.2014, 15:16

14

Можно ж было и удовольствие получить от постижения…

А любопытно было бы взглянуть, каков он ваш манер!



0



Silvermatic

3 / 3 / 0

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

Сообщений: 36

10.03.2014, 16:16

 [ТС]

15

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

Можно ж было и удовольствие получить от постижения…

Взглянув на количество объектов, их методов, свойств и параметров, на их замудреную иерархию…
Надо было в начале спросить что и какими функциями сделать, а логику заложить самостоятельно.

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

А любопытно было бы взглянуть, каков он ваш манер!

Почему же и не показать? Смотрите…

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
29
30
31
32
33
34
35
Sub NewRowWithResults()
Dim rb As Integer
Dim re As Integer
Dim cb As Integer
Dim ce As Integer
Dim cl As Cell, ct$
 
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Выделение за пределами таблицы!", vbCritical
    Exit Sub
End If
 
rb = Selection.Rows.First.Index
re = Selection.Rows.Last.Index
cb = Selection.Columns.First.Index
ce = Selection.Columns.Last.Index
 
Selection.InsertRowsBelow 1
 
For i = cb To ce
    sum = 0
    cnt = 0
    For j = rb To re
        ct = ActiveDocument.Tables(1).Cell(j, i).Range.Text
        ct = Left$(ct, Len(ct) - 2)
        If IsNumeric(ct) Then
          sum = sum + CDbl(ct)
          cnt = cnt + 1
        End If
    Next j
    If sum <> 0 Then
        ActiveDocument.Tables(1).Cell(re + 1, i).Range = sum / cnt
    End If
Next i
End Sub

Ах, да, вот еще хотел уточнить что объявляется в этой строке? В смысле ни что объявляется, а что за объявление «ct$»?

Visual Basic
1
Dim cl As Cell, ct$

И как вычеркнуть из этого объявления переменную cl. ct$, как я понял, что-то вроде указателя в Си?



1



15136 / 6410 / 1730

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

Сообщений: 9,999

10.03.2014, 18:28

16

Dim ct$ это сокращенная запись Dim ct As String.
Несколько наиболее популярных типов в VB/VBA имеют символы для обозначения типа.
См. F1 — String Data Type, Integer Data Type и т.д.



0



3 / 3 / 0

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

Сообщений: 36

10.03.2014, 19:38

 [ТС]

17

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

Dim ct$ это сокращенная запись Dim ct As String.

Значит примерно правильно понял. Спасибо за объяснения.



0



Like this post? Please share to your friends:
  • Vba word сумма прописью
  • Vba word структура документа
  • Vba word стиль текста
  • Vba word список папок
  • Vba word сохранить как pdf