МВТ пишет:Да, механическая ошибка. Замените строку
address = "A" & i & ":A" & i + 4
на
address = "A" & i & ":A" & i + 3
И удалите строку
Какие могут быть проблемы при форматировании таблицы, скопированной из экселя в ворд мне не совсем понятно, возможно Вам имеет смысл задать соответствующий вопрос на этом форуме с описанием сложностей?
МВТ, благодарю за помощь. Всёработает. ВАш макрос работает в Excell.
Ещё мне для Ворда помог с макросом Александр. Вот его код:
'Удаление строк
Sub DeleteRows()
Dim oRow As Row
Set oRow = Selection.Tables(1).Rows.First
Do
If oRow.Cells(1).Range.text Like "мужчин*" Then
oRow.Next.Delete
oRow.Next.Delete
oRow.Next.Delete
Set oRow = oRow.Next
oRow.Previous.Delete
Else
Set oRow = oRow.Next
End If
Loop Until oRow Is Nothing
End Sub
'Объединение ячеек
Sub MergeCells()
' Массив со строками, которые должны быть в первой ячейке объединяемых строк таблицы
Dim Branches() As Variant
Branches = Array( _
"Сельское хозяйство, охота и лесное хозяйство", _
"Добыча полезных ископаемых", _
"Добыча топливно-энергетических полезных ископаемых", _
"Добыча полезных ископаемых, кроме топливно-энергетических", _
"Обрабатывающие производства", _
"Производство пищевых продуктов, включая напитки, и табака", _
"Текстильное и швейное производство", _
"Производство кожи, изделий из кожи и производство обуви", _
"Обработка древесины и производство изделий из дерева", _
"Целлюлозно-бумажное производство; издательская и полиграфическая деятельность", _
"Производство кокса, нефтепродуктов и ядерных материалов", _
"Химическое производство", _
"Производство резиновых и пластмассовых изделий", _
"Производство прочих неметаллических минеральных продуктов", _
"Производство готовых металлических изделий", _
"Производство машин и оборудования", _
"Производство электрооборудования, электронного и оптического оборудования", _
"Производство транспортных средств и оборудования", _
"Прочие производства", _
"Производство и распределение электроэнергии, газа и воды", _
"Строительство", _
"Связь", _
"Транспорт и связь" _
)
Dim i As Long
Dim cellText As String
For i = 1 To Selection.Tables(1).Rows.Count
With Selection.Tables(1).Rows.Item(i)
cellText = .Cells(1).Range.text
cellText = Left(cellText, Len(cellText) - 2)
If Contains(Branches, cellText) Then
.Cells.Merge
.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
End If
End With
Next
End Sub
'Функция проверяет содержится ли в массиве искомая строка
Private Function Contains(ar() As Variant, text As String)
Dim i As Integer
If Len(text) = 0 Then
Contains = False
Exit Function
End If
For i = 1 To UBound(ar)
If Trim(LCase(ar(i))) = Trim(LCase(text)) Then
Contains = True
Exit Function
End If
Next
Contains = False
End Function
А по поводу вставки таблиц из экселя в ворд есть проблемы. например, таблица выходит за границы документа, приходится сдвигать графы по порядку..документ то огромный, таблица на 100стр. одну графу сдвинул, ждешь пока это по всей таблице пройдет, секунд 20.. тормозит.. но где то здесь на форуме я видел рекомендации по грамотной вставке таблиц из эксел..