Копирование изображений Word VBA

@Nazhitkov · Регистрация: 23.04.2014

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

Здравствуйте. Есть проблема при копировании картинок из одного документа word в другой. Суть задачи состоит в том чтобы в активном доке отыскать первую картинку (документ содержит таблицы и картинки), скопировать ее и вставить в другой документ с подписью" Рисунок А-1". Код написанный вылетает с ошибкой:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim pathFile As String
 
Sub Picture()
 
pathFile = ActiveDocument.FullName
Documents.Open FileName:="C:\1.docx"
 
Documents(pathFile).Activate
 ActiveDocument.InlineShapes(1).Range.Copy
 
Documents("C:\1.docx").Activate 
 ActiveDocument.Range.Paste 
 
End Sub

@Казанский · 22.05.2014, 14:43

Nazhitkov, какая ошибка, в какой строке?
Может, не InlineShapes(1), а Shapes(1)?

@Nazhitkov · 22.05.2014, 14:53 **[ТС]**

Казанский,Ошибка в этой строчке

Сообщение от Nazhitkov

ActiveDocument.InlineShapes(1).Range.Cop y

. Пишет Method or data member not found. Попробовал поменять на shapes(1),то же.

Добавлено через 6 минут
Казанский, извиняюсь, при исходной строчке с InlineShapes(1) пишет ошибку "Метод или свойство недоступны, поскольку выделенный текст отсутствует"

@KoGG · 22.05.2014, 15:05

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Picture()
 Dim pathFile As String
 With ActiveDocument
    If .InlineShapes.Count > 0 Then
        .InlineShapes(1).Select
        Selection.Copy
    ElseIf .Shapes.Count > 0 Then
        .Shapes(1).Select
        Selection.Copy
    End If
    pathFile = .FullName
 End With
 Documents.Open FileName:="C:\temp\1.docx"
 Selection.Paste
End Sub

@Nazhitkov · 22.05.2014, 15:20 **[ТС]**

KoGG, Спасибо,копирование работает.А в чем разница Shapes от InlineShapes?

@KoGG · 22.05.2014, 15:46

InlineShape - установлено обтекание фигуры в тексте,
Shape - установлено любое другое обтекание (даже если это один и тот же рисунок или фигура).

@Nazhitkov · 22.05.2014, 15:55 **[ТС]**

KoGG, Спасибо!А не подскажите как сделать подпись для каждого нового вставленного рисунка в формате А1,А2,А3...и т.д.?

@KoGG · 22.05.2014, 17:10

1 раз создать в документе название "А" (вдобавок к "Рисунок", "Таблица")

Visual Basic
1
CaptionLabels.Add Name:="А"

Можно и руками.
После каждого копирования рисунка добавить строку

Visual Basic
1
    Selection.InsertCaption Label:="А", TitleAutoText:="InsertCaption1", Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0

@Nazhitkov · 23.05.2014, 11:21 **[ТС]**

KoGG, Спасибо за ответы,а можно ли еще в подпись вставить переменную?Например "Рисунок А1 Помещение 11",где номер помещения есть переменная?

Добавлено через 15 минут
Казанский, можно ли еще в подпись вставить переменную?Например "Рисунок А1 Помещение 11",где номер помещения есть переменная? (простите за назойливость)

@KoGG · 23.05.2014, 12:12

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

@Nazhitkov · 23.05.2014, 12:23 **[ТС]**

KoGG, хорошо,но вот только у меня название заменяет картинку вставленную. Я еще так понял что нельзя присвоить значение переменной и с ним работать? Вот код что у меня вышел

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
Dim pathFile As String
Sub Picture()
 With ActiveDocument
     
     If .InlineShapes.Count > 0 Then
        .InlineShapes(1).Select
        Selection.Copy
    ElseIf .Shapes.Count > 0 Then
        .Shapes(1).Select
        Selection.Copy
    End If
    pathFile = .FullName
 End With
 Documents.Open FileName:="C:\ad.docx"
 Selection.Paste
 Selection.InsertCaption Label:="А", TitleAutoText:="", _
         Title:=" Помещение ", _
         Position:=wdCaptionPositionBelow, ExcludeLabel:=0
         
Documents(pathFile).Activate
 
ActiveDocument.Tables(1).cell(1, 1).Range.Copy ' как копировать значение ячейки, а не саму ячейку?
 
Documents("C:\ad.docx").Activate
ActiveDocument.Range.Paste
End Sub

@KoGG · 23.05.2014, 14:53

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 Picture()
 Dim Strtemp As String
 With ActiveDocument
    If .InlineShapes.Count > 0 Then
        .InlineShapes(1).Select
        Selection.Copy
    ElseIf .Shapes.Count > 0 Then
        .Shapes(1).Select
        Selection.Copy
    End If
    pathFile = .FullName
    Strtemp = " " & Replace(.Tables(1).Cell(1, 1).Range.Text, Chr(7), "")
 End With
 Documents.Open FileName:="C:\temp\1.docx"
 With Selection
    .Paste
    .Collapse Direction:=wdCollapseEnd
    .TypeParagraph
    .Collapse Direction:=wdCollapseEnd
    .InsertCaption Label:="À", TitleAutoText:="", _
            Title:=" Ïîìåùåíèå ", _
            Position:=wdCaptionPositionBelow, ExcludeLabel:=0
    .Collapse Direction:=wdCollapseEnd
    .TypeText Text:=Strtemp
 End With
End Sub

Еще никому не удавалось сносно работать с макросами Word и не заглядывать в справку по VBA для Word. Почитайте хотя бы азы.

@Nazhitkov · 23.05.2014, 15:14 **[ТС]**

KoGG, Я научился работать с Range,но с Selection пока не очень освоился.Буду дальше изучать,может что то и выйдет.Спасибо еще раз огромное.

Новые блоги и статьи Все статьи Все блоги /
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .

@Казанский 15155 / 6428 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	22.05.2014, 14:43
	Nazhitkov, какая ошибка, в какой строке? Может, не InlineShapes(1), а Shapes(1)? 0

@Nazhitkov 0 / 0 / 0 Регистрация: 23.04.2014 Сообщений: 23
	22.05.2014, 15:20 [ТС]
	KoGG, Спасибо,копирование работает.А в чем разница Shapes от InlineShapes? 0

@KoGG 5646 / 1628 / 418 Регистрация: 23.12.2010 Сообщений: 2,450 Записей в блоге: 1
	22.05.2014, 15:46
	InlineShape - установлено обтекание фигуры в тексте, Shape - установлено любое другое обтекание (даже если это один и тот же рисунок или фигура). 0

@Nazhitkov 0 / 0 / 0 Регистрация: 23.04.2014 Сообщений: 23
	22.05.2014, 15:55 [ТС]
	KoGG, Спасибо!А не подскажите как сделать подпись для каждого нового вставленного рисунка в формате А1,А2,А3...и т.д.? 0

@Nazhitkov 0 / 0 / 0 Регистрация: 23.04.2014 Сообщений: 23
	23.05.2014, 11:21 [ТС]
	KoGG, Спасибо за ответы,а можно ли еще в подпись вставить переменную?Например "Рисунок А1 Помещение 11",где номер помещения есть переменная? Добавлено через 15 минут Казанский, можно ли еще в подпись вставить переменную?Например "Рисунок А1 Помещение 11",где номер помещения есть переменная? (простите за назойливость) 0

@KoGG 5646 / 1628 / 418 Регистрация: 23.12.2010 Сообщений: 2,450 Записей в блоге: 1
	23.05.2014, 12:12
	В подпись с автонумерацией переменную, задействованную в макросе, вставить можно, но во всех подписях будет значение переменной на момент вставки. Надо просто допечатывать текст после подписи с автонумерацией. 0

@Nazhitkov 0 / 0 / 0 Регистрация: 23.04.2014 Сообщений: 23
	23.05.2014, 15:14 [ТС]
	KoGG, Я научился работать с Range,но с Selection пока не очень освоился.Буду дальше изучать,может что то и выйдет.Спасибо еще раз огромное. 0