Vba word вставка картинки

Обновлено: 07.01.2025

Приветствую.
Другой день бодаюсь со вставкой рисунков в Word.

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

Без костыля меняется только либо высота, либо ширина. При этом ошибки нет
Сегодня создал шаблон с таблицей в 1 ячейку, написал код для вставки

Аналогичным кодом вставляю рисунок на лист, но вылетаю с ошибкой.

Подскажите, где собака порылась? И как правильно?

Обработка идет из Excel.

w d .Bookmarks.Item(marker).Select
w a .Selection.InlineShapes.AddPicture

Эти строки работают, рисунок вставляется.
Не могу изменить размеры
В первом и последнем коде не работают фрагменты
Усомнился, и еще рад проверил
При смене wa и wd получаю объект не поддерживает свойство или метод.
Помнится мне, что у меня тоже не получалось. И я пересчитывал размер, если нужно было сохранить пропорции. Судя из объяснения на мсдн

True if the specified shape retains its original proportions when you resize it. False if you can change the height and width of the shape independently of one another when you resize it. Read/write MsoTriState.

Этот параметр не реагирует на программное изменение ширины или высоты, хотя не совсем ясно, что они понимают под resize.
Для удобства, помести картинку в переменную:
Этим мы ты избавишься от необходимости выделять таблицу, для того, чтобы из выделения получить вставленную картинку.

Идея интересная. Поковыряю.
Не ясно, почему при вставке через закладку не работает (1), а при вставке в таблицу напрямую (2) - работает.
И как достучаться до рисунка, вставленного помимо таблицы?

PS Пересчитывать размер - костыль в коде 1.

Потестил.
Переменная помогла. Спасибо.

Однако, похоже в файле Word глюк.
Тестовый работает, а основной без костыля не хочет.

Вы можете добавлять изображения и графические объекты в документы во время разработки или во время выполнения. WordArt позволяет добавлять декоративный текст в документы Microsoft Office Word. Эти специальные текстовые эффекты представляют собой графические объекты, которые можно настроить и вставить в документ.

Применимо к: Сведения в этом разделе относятся к - проектам уровня документа и добавлению VSTO - в проектах для Word. Дополнительные сведения см. в разделе доступность функций по типам приложений Office и проектов.

Добавление рисунка во время разработки

При создании настройки на уровне документа вы можете добавить изображение в документ во время разработки.

Добавление рисунка в документ Word во время разработки

Поместите курсор в место вставки изображения в документе.

Щелкните вкладку Вставка ленты.

В группе иллюстраций щелкните Рисунок.

В диалоговом окне Вставка рисунка перейдите к рисунку, который необходимо вставить, и нажмите кнопку Вставить.

Рисунок добавляется в документ в текущем положении курсора.

Добавить изображение во время выполнения

Рисунок можно вставить в документ в текущем положении курсора.

Добавление рисунка в позиции курсора

Вызовите метод AddPicture коллекции InlineShapes и передайте имя файла.

Добавление объекта WordArt во время разработки

При создании настройки на уровне документа вы можете добавить объект WordArt в документ во время разработки.

Добавление объекта WordArt в документ Word во время разработки

Поместите курсор в место вставки объекта WordArt в документе.

Щелкните вкладку Вставка ленты.

В текстовой группе щелкните объект WordArt, а затем выберите стиль WordArt.

Добавьте текст, который должен появиться в документе, в диалоговое окно изменение текста WordArt и нажмите кнопку ОК.

Текст добавляется к документу с выбранным стилем WordArt.

Добавление объекта WordArt во время выполнения

Вы можете вставить объект WordArt в документ в текущем положении курсора. Процедура вставки отличается для настроек на уровне документа и надстроек VSTO.

Добавление объекта WordArt в положении курсора в настройке уровня документа

Получите левую и верхнюю позицию текущего положения курсора.

Вызовите метод AddTextEffect объекта Shapes в документе.

Добавление объекта WordArt в положении курсора в надстройке VSTO

Получите левую и верхнюю позицию текущего положения курсора.

Вызовите метод AddTextEffect объекта Shapes активного документа (или другого указанного документа).

Понадобилось мне тут в свое время писать много текста в MS Word, вставляя туда картинки. Понимая, что картинки рано или поздно понадобится переделывать, я пришел к необходимости вставки не картинок, а ссылок на них. Но вставить поле мало - крайне желательно еще и подписывать имя вставленной картинки.

При этом файл doc / docx может перемещаться между компьютерами (да, я пользуюсь и DropBox, и Yandex.Drive, и OneDrive). Соответственно надо вставлять относительные пути и подписывать их же. Не очень продолжительный поиск по сети и немного фантазии дали такой вариант:

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
67
68
69
70
71
72
73

Public sInitialPath As String

Private Declare Function PathRelativePathToW _
Lib "shlwapi.dll" ( ByVal pszPath As Long , _
ByVal pszFrom As Long , ByVal dwAttrFrom As Long , _
ByVal pszTo As Long , ByVal dwAttrTo As Long ) _
As Boolean

Private Function GetRelativePath _
( ByVal sPathFrom As String , _
ByVal sPathTo As String ) As String
' Определение относительного адреса
' каталога или файла
Dim sRelativePath As String
sRelativePath = Space(260) ' резервируем буфер
'
If PathRelativePathToW(StrPtr(sRelativePath), _
StrPtr(sPathFrom), vbDirectory, _
StrPtr(sPathTo), 0) Then ' определили адрес
'MsgBox sRelativePath
GetRelativePath = Left(sRelativePath, _
InStr(sRelativePath, vbNullChar) - 1)
Else '
GetRelativePath = "*"
End If
End Function

Public Sub InsertLinkToPicture()
Dim sFileName As String
Dim oField As Field
With Application.FileDialog(msoFileDialogOpen)
.Title = "Укажите рисунок"
.AllowMultiSelect = False
.ButtonName = "Select"
.Filters.Clear
.Filters.Add "Картинки" , "*.jpg; *.tiff; *.tif; *.jpg"
If sInitialPath = "" Then sInitialPath = Application.ActiveDocument.Path
.InitialView = msoFileDialogViewList
If .Show Then sFileName = .SelectedItems(1) Else Exit Sub
End With
If Left(Selection.Text, 1) <> Chr(13) Then
Selection.TypeText Text:=vbCr
End If
sFileName = GetRelativePath(Application.ActiveDocument.FullName, sFileName)
Select Case True
Case Left(sFileName, 2) = ".."
sFileName = Right(sFileName, Len(sFileName) - 2)
Case Left(sFileName, 1) = "."
sFileName = Right(sFileName, Len(sFileName) - 1)
End Select
If Left(sFileName, 1) = "/" Or Left(sFileName, 1) = "" Then
sFileName = Right(sFileName, Len(sFileName) - 1)
End If
Set oField = Selection.Fields.Add(Range:=Selection.Range, Type :=wdFieldEmpty, _
Text:= "INCLUDEPICTURE " + Chr(34) + _
Replace(sFileName, "" , "/" ) + _
Chr(34) + " \d " _
, PreserveFormatting:= True )

If InStr(sFileName, "_35%" ) Then
ActiveDocument.Hyperlinks.Add Anchor:=oField.Result, Address:=Replace(sFileName, "_35%" , "" ), SubAddress:= ""
End If

Selection.TypeText Text:=vbCrLf + Replace(sFileName, "_35%" , "" ) 'Right(sFileName, Len(sFileName) - Len(Application.ActiveDocument.Path))
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Italic = True
Selection.Font.Bold = True
Selection.Font.Color = wdColorRed
' Selection.Range.HighlightColorIndex = wdGreen
Selection.EndKey
End Sub

Но, как выяснилось, в MS Office 2013 x64 решение работать не будет (даже если попытаться корректно объявить импорт PathRelativePathToW, VBA отказывается обрабатывать указатели на строки). Поэтому было найдено другое решение:(исходник здесь):

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

Function GetRelativePath(sFrom, sTo)

Do While Len(sFrom) > Len(sFromTmp) Or Len(sTo) > Len(sToTmp)
If Len(sFrom) > Len(sFromTmp) Then
If Not bFirst Then sFrom = Right(sFrom, Len(sFrom) - Len(sFromTmp) - 1)
sFromTmp = GetLeftPart(sFrom)
Else
sFrom = ""
sFromTmp = ""
End If

If Len(sTo) > Len(sToTmp) Then
If Not bFirst Then sTo = Right(sTo, Len(sTo) - Len(sToTmp) - 1)
sToTmp = GetLeftPart(sTo)
Else
sTo = ""
sToTmp = ""
End If

If bFirst And sFromTmp <> sToTmp Then
Exit Function ' Нет общего корня
Else
bFirst = False
End If

If Len(GetRelativePath) > 0 Or sFromTmp <> sToTmp Then
If Len(sFromTmp) > 0 Then
If Len (GetRelativePath) > 0 Then
GetRelativePath = GetRelativePath & "\.."
Else
GetRelativePath = GetRelativePath & ".."
End If
End If
If Len(sToTmp) > 0 Then
If Len(sTmp) > 0 Then
sTmp = sTmp & "" & sToTmp
Else
sTmp = sTmp & sToTmp
End If
End If
End If
Loop

If Len(sTmp) > 0 Then GetRelativePath = GetRelativePath & "" & sTmp
If 0 = Len(GetRelativePath) Then GetRelativePath = "."

For i = 1 To Len(sPath)
If "" = Mid(sPath, i, 1) Then
GetLeftPart = Left(sPath, i - 1)
Exit Function
End If
Next

Для дополнительного комфорта я "обрамил" код строками

Application.UndoRecord.StartCustomRecord
Application.UndoRecord.EndCustomRecord

Тогда по Ctrl+Z будет отменяться все целиком, а не по шагам. Нередко рядом с оригинальным файлом я кладу его "уменьшенную" копию (уменьшение выполняется с FastStone Image Viewer, картинка уменьшается до 35%, имя файла оканчивается на "_35%"). Если рядом с оригиналом есть уменьшенный вариант, в поле вставляется "уменьшенная" копия, а подпись идет на нормальный вариант. В результате получилось такое чудо:

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

Public sInitialPath As String

Public Function GetRelativePath( ByVal sFrom As String , ByVal sTo As String ) As String
GetRelativePath = ""
Dim sFromTmp As String , sToTmp As String , sTmp As String , bFirst As Boolean
sFromTmp = ""
sToTmp = ""
sTmp = ""
bFirst = True
Do While Len(sFrom) > Len(sFromTmp) Or Len(sTo) > Len(sToTmp)
If Len(sFrom) > Len(sFromTmp) Then
If Not bFirst Then sFrom = Right(sFrom, Len(sFrom) - Len(sFromTmp) - 1)
sFromTmp = GetLeftPart(sFrom)
Else
sFrom = ""
sFromTmp = ""
End If

If Len(sTo) > Len(sToTmp) Then
If Not bFirst Then sTo = Right(sTo, Len(sTo) - Len(sToTmp) - 1)
sToTmp = GetLeftPart(sTo)
Else
sTo = ""
sToTmp = ""
End If

If bFirst And sFromTmp <> sToTmp Then
Exit Function ' Нет общего корня
Else
bFirst = False
End If

If Len(GetRelativePath) > 0 Or sFromTmp <> sToTmp Then
If Len(sFromTmp) > 0 Then
If Len(GetRelativePath) > 0 Then
GetRelativePath = GetRelativePath & "\.."
Else
GetRelativePath = GetRelativePath & ".."
End If
End If
If Len(sToTmp) > 0 Then
If Len(sTmp) > 0 Then
sTmp = sTmp & "" & sToTmp
Else
sTmp = sTmp & sToTmp
End If
End If
End If
Loop
If Len(sTmp) > 0 Then GetRelativePath = GetRelativePath & "" & sTmp
If 0 = Len(GetRelativePath) Then GetRelativePath = "."
End Function

Function GetLeftPart(sPath)
Dim i As Integer
For i = 1 To Len(sPath)
If "" = Mid(sPath, i, 1) Then
GetLeftPart = Left(sPath, i - 1)
Exit Function
End If
Next
GetLeftPart = sPath
End Function

Public Sub InsertLinkToPicture()
Dim sFileName As String
Dim oField As Field
Application.UndoRecord.StartCustomRecord

With Application.FileDialog(msoFileDialogOpen)
.Title = "Укажите рисунок"
.AllowMultiSelect = False
.ButtonName = "Select"
.Filters.Clear
.Filters.Add "Картинки" , "*.jpg; *.tiff; *.tif; *.jpg"
If sInitialPath = "" Then sInitialPath = Application.ActiveDocument.Path
.InitialView = msoFileDialogViewList
If .Show Then sFileName = .SelectedItems(1) Else Exit Sub
End With

If Left(Selection.Text, 1) <> Chr(13) Then
Selection.TypeText Text:=vbCr
End If
sFileName = GetRelativePath(Application.ActiveDocument.FullName, sFileName)

Select Case True
Case Left(sFileName, 2) = ".."
sFileName = Right(sFileName, Len(sFileName) - 2)
Case Left(sFileName, 1) = "."
sFileName = Right(sFileName, Len(sFileName) - 1)
End Select

If Left(sFileName, 1) = "/" Or Left(sFileName, 1) = "" Then
sFileName = Right(sFileName, Len(sFileName) - 1)
End If

теперь эту красоту надо на всех страницах разместить)
С циклом по страницам не знаком,
Подскажите пожалуйста.

Добавлено через 8 минут
И ещё есть ли возможность макрос сохранить файлом, чтоб в поле документа перетащить и он установится?

Нужно вставить в разные разделы документа Word текст и картинки
Никак не выходит. Разные разделы создаются, ориентация и размер страницы в разделах тоже меняются.

Получить картинки из документа MS Word
Здравствуйте, помогите пожалуйста со следующей задачей. Мне нужно "вытащить" все картинки из.

Как извлечь картинки из Word документа?
Необходимо извлечь имеющиеся картинки из Word, и конвертнуть их в один из форматов web (gif, jpg).

Как во все листы вставить в определенную ячейку название каждого соответствующего листа
Добрый день! Может кто знает - как решить задачу: как во все листы вставить в определенную ячейку.

amd48, нет.
это картинка из файла, поверх текста в нужном месте, на всех листах. макрос сохранить файлом, чтоб в поле документа перетащить и он установится? Поле документа - это что в ваших терминах? Если надо иметь макрос, который будет работать с разными документами, то можно разместить его в шаблоне Normal.dot и для него сделать кнопку. Или лучше сделать надстройку - это dot-шаблон в папке %appdata%\Microsoft\Word\STARTUP

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

Добавлено через 1 минуту

Поле документа - это что в ваших терминах? Если надо иметь макрос, который будет работать с разными документами, то можно разместить его в шаблоне Normal.dot и для него сделать кнопку. Или лучше сделать надстройку - это dot-шаблон в папке %appdata%\Microsoft\Word\STARTUP Думаю это я и имел ввиду, только Вы корректно это описали))

amd48, Спасибо! Отлично работает!

Что-то не могу понять, как dot-шаблон сохранить?

Добавлено через 2 минуты
В итоге вышло так(добавил возможность выбора картинки):

Сохранить как. Выбрать "шаблон". Ворд автоматически откроет для сохранения папку шаблонов. Но надо выбрать %appdata%\Microsoft\Word\STARTUP
Желательно использовать формат 2003-го ворда, а не эти новые dotxи всё такое. В старых форматах макросы сохранялись без вопросов. В новых надо всегда выбирать формат именно с поддержкой макросов, иначе они не сохранятся. И всё программирование улетит в трубу А я потом смогу этот шаблон на другой комп перекинуть?

amd48, действительно, чёто затупил я

Добавлено через 1 минуту
amd48, а в надстройку это все запихать? Это особенный какой-то танец с бубном?
Или решаемо без особых усилий?

Вставить картинки в определенные места документа в определенном размере
Добрый день, подскажите, плз: как с помощью макросов реализовать следующее: word 2007 есть.

Как вставить текст в определенное место WORD документа?
Подскажите пожалуйста, как вставить программно в вордовский документ текст в определенное место и.

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

Как считать текст, таблицы и картинки из документа word
Как считать текст, таблицы и картинки из документа word? И наоборот записать в него. Попытался сам.

Макрос Word: вставить в конец документа строчку с информацией о документе
Нужен макрос, вставляющий в конец документа строчку с информацией о документе (путь, имя, дата.

На оборотной стороне документа word в правой части документа, текст съезжает за границу документа
Добрый вечер. Есть код, который формирует документ из шаблона. И все вроде бы, но происходит что.

Читайте также: