Макрос для сложной связи

@eemil · Регистрация: 15.01.2016

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

Здравствуйте, люди добрые и грамотные. Перейду сразу к делу. Есть два шаблона, один в Word, другой в Excel. Есть так же основная таблица в Excel, некоторые ячейки которой нужно вставить (связать!) в определенные места в шаблонах. Нюансы – шаблоны размером в одну страницу, а строк в основной таблице множество. Соответственно, нужно создать столько листов, сколько строк в основной табл. и причем в одном документе/книге. Еще все эти конкретные ячейки из основной таблицы должны быть связаны с шаблонами, для того чтобы в дальнейшем все изменения проводимые в общей таблице, автоматически менялись при обновлении на всех созданных листах в Worde и Excel. Пробовал делать с помощью «Слияния» и все хорошо, но в созданных листах нету связи, то есть данные просто копируются. Пробовал и «Специальную вставку->Связать формат RTF», но таким образом приходится слишком много делать связей вручную.

@KoGG · 18.01.2016, 17:24

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
36
37
38
39
40
41
Sub Создать_текст_из_шаблонов()
    Const ShablonPathName$ = "C:\Temp_Example\Рыба.docx"
    Const kolS = 3
    Const FirstRow& = 2
    Dim i&, j&, LastRow&, FindText$
    Dim WA As Object, WD As Object
    Set WA = CreateObject("Word.Application")
    WA.Visible = True
    Set WD = WA.Documents.Add(Template:="Normal"): DoEvents
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = FirstRow To LastRow
        WA.Selection.EndKey Unit:=6 'wdStory
        WA.Selection.InsertFile Filename:=ShablonPathName
        For j = 1 To 100: DoEvents: Next
        WA.Selection.EndKey Unit:=6 'wdStory
        WA.Selection.InsertBreak Type:=0
        WA.Selection.HomeKey Unit:=6 'wdStory
        For j = 1 To kolS
            FindText = Cells(1, j)  ' уникальный Текст для замены = заголовок столбца на активном листе Excel
            With WA.Selection.Find
                .Text = FindText
                .Forward = True
                .Wrap = 0 'wdFindStop
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                If .Execute Then
                     Cells(i, j).Copy
                     WA.Selection.PasteSpecial Link:=True, DataType:=0, Placement:=0  '0=wdPasteOLEObject, 0=wdInLine
                End If
            End With
            DoEvents
        Next j
    Next i
    DoEvents
    Set WD = Nothing
    Set WA = Nothing
End Sub

Макрос запускать из Excel , при активном файле с данными.
В документе Word "Фрагмент Рыба" повторяется много раз, найденные метки в каждой "рыбе" связывается с файлом Excel, с текущей строкой.
Имя и путь к "файлу рыбе" надо заменить в макросе в файле Excel.

@eemil · 21.01.2016, 21:21 **[ТС]**

Это не совсем то, что нужно. Для примера есть рабочий макрос только для Excel, по такому же принципу нужно формировать листы в 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
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
61
62
63
64
65
66
Sub my1()
    Dim r As Long
    Dim wb As Workbook, wb1 As Workbook, sFT As Worksheet
    Set wb = ThisWorkbook
    Set sFT = wb.Sheets("FT")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error GoTo erHdl
    For r = 3 To sFT.Cells(sFT.Rows.Count, 1).End(xlUp).Row Step 2
        wb.Sheets("Шаблон").Copy after:=wb1.Sheets(wb1.Sheets.Count)
shRdy:  With wb1.Sheets(wb1.Sheets.Count)
            .Name = Left(sFT.Cells(r, 1), 31)
            .Range("C15").Formula = "=" & sFT.Cells(r, 1).Address(external:=True)
            .Range("D15").Formula = "=" & sFT.Cells(r, 23).Address(external:=True)
            .Range("G15").Formula = "=" & sFT.Cells(r, 3).Address(external:=True)
            .Range("H15").Formula = "=" & sFT.Cells(r, 4).Address(external:=True)
            .Range("H16").Formula = "=" & sFT.Cells(r, 5).Address(external:=True)
            .Range("H17").Formula = "=" & sFT.Cells(r, 6).Address(external:=True)
            .Range("H18").Formula = "=" & sFT.Cells(r, 7).Address(external:=True)
            .Range("I15").Formula = "=" & sFT.Cells(r, 8).Address(external:=True)
            .Range("I16").Formula = "=" & sFT.Cells(r, 9).Address(external:=True)
            .Range("I17").Formula = "=" & sFT.Cells(r, 10).Address(external:=True)
            .Range("I18").Formula = "=" & sFT.Cells(r, 11).Address(external:=True)
            .Range("J16").Formula = "=" & sFT.Cells(r, 16).Address(external:=True)
            .Range("K16").Formula = "=" & sFT.Cells(r, 17).Address(external:=True)
            .Range("L15").Formula = "=" & sFT.Cells(r, 12).Address(external:=True)
            .Range("L16").Formula = "=" & sFT.Cells(r, 13).Address(external:=True)
            .Range("L17").Formula = "=" & sFT.Cells(r, 14).Address(external:=True)
            .Range("L18").Formula = "=" & sFT.Cells(r, 15).Address(external:=True)
            .Range("G26").Formula = "=" & sFT.Cells(r, 27).Address(external:=True)
            
            .Range("C27").Formula = "=" & sFT.Cells(r + 1, 1).Address(external:=True)
            .Range("D27").Formula = "=" & sFT.Cells(r + 1, 23).Address(external:=True)
            .Range("G27").Formula = "=" & sFT.Cells(r + 1, 3).Address(external:=True)
            .Range("H27").Formula = "=" & sFT.Cells(r + 1, 4).Address(external:=True)
            .Range("H28").Formula = "=" & sFT.Cells(r + 1, 5).Address(external:=True)
            .Range("H29").Formula = "=" & sFT.Cells(r + 1, 6).Address(external:=True)
            .Range("H30").Formula = "=" & sFT.Cells(r + 1, 7).Address(external:=True)
            .Range("I27").Formula = "=" & sFT.Cells(r + 1, 8).Address(external:=True)
            .Range("I28").Formula = "=" & sFT.Cells(r + 1, 9).Address(external:=True)
            .Range("I29").Formula = "=" & sFT.Cells(r + 1, 10).Address(external:=True)
            .Range("I30").Formula = "=" & sFT.Cells(r + 1, 11).Address(external:=True)
            .Range("J28").Formula = "=" & sFT.Cells(r + 1, 16).Address(external:=True)
            .Range("K28").Formula = "=" & sFT.Cells(r + 1, 17).Address(external:=True)
            .Range("L27").Formula = "=" & sFT.Cells(r + 1, 12).Address(external:=True)
            .Range("L28").Formula = "=" & sFT.Cells(r + 1, 13).Address(external:=True)
            .Range("L29").Formula = "=" & sFT.Cells(r + 1, 14).Address(external:=True)
            .Range("L30").Formula = "=" & sFT.Cells(r + 1, 15).Address(external:=True)
            .Range("G38").Formula = "=" & sFT.Cells(r + 1, 27).Address(external:=True)
        End With
    Next r
MsgBox "Готово"
GoTo fin
 
erHdl:
  If Err.Number = 91 Then 'Object variable or With block variable not set
    wb.Sheets("Шаблон").Copy
    Set wb1 = ActiveWorkbook
    Resume shRdy
  End If
  MsgBox "Непредвиденная ошибка" & Err.Number & vbLf & Err.Description, vbCritical
 
fin:
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

На основе шаблона он создает книгу и в зависимости от числа строк в общей таблице, создает такое же число листов. Необходимо по такому же принципу формировать листы в документе Word. То есть, есть шаблон в Word к которому будет обращаться макрос и связывать ячейки из Excel с закладками в шаблоне. Связь должна быть RTF. Как такое можно реализовать, подскажите пожалуйста?

shanemac51 · 21.01.2016, 21:41

переменной wb1 As Workbook не присвоено значение

Новые блоги и статьи Все статьи Все блоги /
Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизита табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать контроль заполнения реквизита "ПричинаСписания". . .
wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .	Программное заполнения текстового поля в реквизите формы документа Maks 01.04.2026 Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .

@eemil 0 / 0 / 0 Регистрация: 15.01.2016 Сообщений: 5

	Макрос для сложной связи 16.01.2016, 08:27. Показов 992. Ответов 3 Метки нет (Все метки) Здравствуйте, люди добрые и грамотные. Перейду сразу к делу. Есть два шаблона, один в Word, другой в Excel. Есть так же основная таблица в Excel, некоторые ячейки которой нужно вставить (связать!) в определенные места в шаблонах. Нюансы – шаблоны размером в одну страницу, а строк в основной таблице множество. Соответственно, нужно создать столько листов, сколько строк в основной табл. и причем в одном документе/книге. Еще все эти конкретные ячейки из основной таблицы должны быть связаны с шаблонами, для того чтобы в дальнейшем все изменения проводимые в общей таблице, автоматически менялись при обновлении на всех созданных листах в Worde и Excel. Пробовал делать с помощью «Слияния» и все хорошо, но в созданных листах нету связи, то есть данные просто копируются. Пробовал и «Специальную вставку->Связать формат RTF», но таким образом приходится слишком много делать связей вручную. 0

shanemac51 Модератор 12231 / 5078 / 814 Регистрация: 07.08.2010 Сообщений: 14,941 Записей в блоге: 4
	21.01.2016, 21:41
	переменной wb1 As Workbook не присвоено значение 0