Vba word вставить картинку в колонтитул

Добрый день!
На просторах интернета нашел макрос, который вставляет картинку в колонтитул документа Word. Он прекрасно работает из Ворда.

Также у меня есть макрос в Excel, который работает с этим файлом (который с миру по нитке насобирал по всему интернету, понимания пока не хватает в чем разница между работой из Excel с другим приложением Microsoft, поэтому часто даже рабочий код у меня не работает))
Вот код основного макроса в Excel

Тут даже не знаю как сформулировать свой вопрос, заранее извиняюсь.
Как мне сделать так, чтобы я из процедуры Zapusk_Word_iz_Excel_02 сделал Call UpdateHeader и это дело заработало?
Поначалу выдает ошибку еще при объявлении типа данных

Dim oDoc As Word.Document
    Dim oSec As Word.Section

…ну оно и понятно, Excel таких типов не знает…а как сделать чтобы знал?

Нравится ресурс? Помоги проекту!

Вставка рисунка в колонтитул ворда
, Как назначить формат?

• Подписаться на тему
• Сообщить другу
• Скачать/распечатать тему

Сообщ. #1 , 30.01.11, 07:18

Full Member Рейтинг (т): 20

Работаю с документом ворд из VB6 Сюда задаю вопрос — думаю это ближе к VBA чем к VB Разобрался со всеми вопросами кроме одного: Вставляю в колонтитул рисунок: Код: ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader     Selection.InlineShapes.AddPicture FileName:=Лого.Text, _         LinkToFile:=False, SaveWithDocument:=True Но он вставляется с форматом «В тексте». В результате весь многостраничный документ становится раком. Вопрос: как при вставке указать формат рисунка «Перед текстом» _________________

Alex77

Сообщ. #2 , 30.01.11, 09:01

Full Member Рейтинг (т): 20

Либо другой вариант. Вставил в заготовку в нужные места рамки. И в них вставляю картинки. Так ворд не передёргивает. Но опять проблема. Вставил 4 рамки. Одна из них в колонтитуле. В коллекции Frames только три рамки. Где искать четвёртую? Как к ней обратится? Перевёл в режим колонтитулов: ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Вручную(в режиме стопа) щёлкаю по рамке в колонтитуле — выделяется. Следующий шаг Selection.Range.Paste Вставляет как мне надо. Если вручную не выделю — вставляет не в рамку, а просто в колонтитул и в формате «В тексте» со всеми вытекающими последствиями

Alex77	Сообщ. #3 , 30.01.11, 10:45
Full Member Рейтинг (т): 20	Отвечаю сам себе. Может кому надо: PIC.Picture = LoadPicture(Лого.Text)     Clipboard.Clear     Clipboard.SetData PIC.Picture     Dim asd ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Set asd = Selection.InlineShapes.AddPicture(FileName:=Лого.Text, _         LinkToFile:=False, SaveWithDocument:=True) asd.ConvertToShape ActiveWindow.View.Type = wdPrintView

Old Bat	Сообщ. #4 , 30.01.11, 13:26
Moderator Рейтинг (т): 128	можно и короче, например: ActiveDocument.Sections(1).Headers(1).Shapes.AddPicture «my_foto.jpg», , True

Alex77

Сообщ. #5 , 30.01.11, 18:10

Full Member Рейтинг (т): 20

Тот вариант оказался не подходящим — при добавлении рисунка он вставляется в натуральнюу величину. В рекомендациях говорилось о методе вставки через буфер. Но я не мог найти доступа к рамке в колонтитуле. Не знал где её искать. В конце концов посказали, где её найти. Окончательный вариант вполне устраивающий меня: PIC.Picture = LoadPicture(Лого.Text)     Clipboard.Clear     Clipboard.SetData PIC.Picture ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader  ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes(1).Select Selection.Range.Paste     ActiveWindow.View.Type = wdPrintView .Sections(1).Headers( — оказались ключевыми словами. Всем спасибо

Old Bat	Сообщ. #6 , 30.01.11, 20:10
Moderator Рейтинг (т): 128	в таком случае зачем менять вид и делать лишний селект — попробуй вставку напрямую PIC.Picture = LoadPicture(Лого.Text) Clipboard.Clear Clipboard.SetData PIC.Picture ActiveDocument.Sections(1).Headers(1).Range.Paste

Alex77	Сообщ. #7 , 30.01.11, 20:57
Full Member Рейтинг (т): 20	Пока не поменял вид — вдавало ошибку: нет доступа Правда я пытался выделить. Попробую без выделения. Спасибо Блин!! Точно работает. А я три дня лазил не мог понять, где эта клятая рамка делась. Остальные в коллекции, а одной там нет: DocWord.Frames.Item(1).Range.Paste Сообщение отредактировано: Alex77 — 30.01.11, 21:04

Old Bat	Сообщ. #8 , 30.01.11, 22:08
Moderator Рейтинг (т): 128	от лишних выделений при возможности лучше избавляться, как правило это бесполезное наследие автоматической записи макроса

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

• Предыдущая тема
• VB for Application
• Следующая тема

[ Script execution time: 0,0483 ]   [ 16 queries used ]   [ Generated: 14.04.23, 17:32 GMT ]  

Dim SrcePath As String

SrcePath = "C:UserspcPicturessignature.png"

Dim t As Long
With WordDoc
  For t = 1 To .Tables.Count
    Set wdRng = .Tables(t).Range.Characters.Last.Next
    If wdRng.End < .Range.End Then
      If wdRng.Text = vbCr Then wdRng.Delete
    End If
  Next
  .TablesOfContents(1).Update
  .Sections(1).Footers(1).Range.InlineShapes.AddPicture (SrcePath)
End With

1 ответ

Лучший ответ

.Sections(1).Footers(1).Range.InlineShapes.AddPicture (SrcePath)

Dim t As Long

Dim t As Long, Shp As Shape, sPosH As Single

.Sections(1).Footers(1).Range.InlineShapes.AddPicture (SrcePath)

  With .Sections(1).PageSetup
    sPosH = .PageWidth - .LeftMargin - .RightMargin - .Gutter
  End With
  Set Shp = .Sections(1).Footers(1).Shapes.AddPicture(SrcePath, False, True)
  With Shp
    .LockAspectRatio = True
    .Width = Application.InchesToPoints(2)
    .LeftRelative = 0 'wdRelativeHorizontalPositionMargin
    .Left = sPosH - .Width
    .TopRelative = 5 'wdRelativeVerticalPositionBottomMarginArea
    .Top = 0
    .WrapFormat.Type = 6 'wdWrapFront
  End With

Код

Код

Selection.InlineShapes.AddPicture FileName:=»D:TEST1.png», _
LinkToFile:=False, SaveWithDocument:=True

Код

Set Shape_P = Selection.InlineShapes.AddPicture(FileName:=»D:ФАЙЛЫ_КЛИШЕПЕЧАТЬпечать.png», _
LinkToFile:=False, SaveWithDocument:=True, Range:=Selection.Range).ConvertToShape
Shape_P.WrapFormat.Type = wdWrapBehind

I’m trying to insert a image in the first page header of a document, trough VBA.

There are multiple lines that can do this, but each has it problem, which I will list:

This is my favorite method, but it inserts the image not in the header of first page, but all the remaining ones, and it also doesn’t allow me to set the position:

ActiveDocument.Sections(1).Headers(2).Shapes.AddPicture ("C:1.jpg")

This returns an out of bounds error:

Set shpCanvas=ActiveDocument.Shapes.AddCanvas(Left:=0, Top:=0, Width:=180, Height:=50)

shpCanvas.CanvasItems.AddPicture FileName:="C:1.jpg", LinkToFile:=False, SaveWithDocument:=True

Inserts the image directly, but its usually out of position, stays in the middle of the header where I’d rather have it on the left

ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.InlineShapes.AddPicture ("C:1.jpg")

I’m just a beginner with VBA and word, I apologize for any grotesque ideas I might have

Я получил документ.docx, созданный с помощью Apache POI. Я открыл его и попытался вставить изображения верхнего и нижнего колонтитула, выполнив два макроса:

Sub Header_Bild_Einfuegen()
    If ActiveDocument.ProtectionType <> wdNoProtection Then
        ActiveDocument.Unprotect
    End If

    Dim oShape As Shape, oRange As Range
    Dim Pfad As String
    Pfad = "C:UserspathtoheaderIcon.jpeg"

    Set oRange =     ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
    Set oShape = ActiveDocument.Shapes.AddPicture(FileName:=Pfad, _
    LinkToFile:=False, SaveWithDocument:=True, Anchor:=oRange)

    oShape.Height = CentimetersToPoints(4.8)
    oShape.Width = CentimetersToPoints(21.55)
    oShape.Left = CentimetersToPoints(-2.44)
    oShape.Top = CentimetersToPoints(-1.28)
    oShape.ZOrder msoSendBehindText

End Sub

Sub Footer_Bild_Einfuegen()
    If ActiveDocument.ProtectionType <> wdNoProtection Then
        ActiveDocument.Unprotect
    End If
    '
    Dim oShape As Shape, oRange As Range
    Dim Pfad As String
    Pfad = "C:UserspathtofooterIcon.jpeg"

    Set oRange =     ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
    Set oShape = ActiveDocument.Shapes.AddPicture(FileName:=Pfad, _
    LinkToFile:=False, SaveWithDocument:=True, Anchor:=oRange)

    oShape.Height = CentimetersToPoints(2.4)
    oShape.Width = CentimetersToPoints(21.55)
    oShape.Left = CentimetersToPoints(-2.44)
    oShape.ZOrder msoSendBehindText
End Sub

Моя проблема: оба изображения вставляются в верхний колонтитул документа, нижний колонтитул остается пустым (но существует, содержит текст (как и заголовок)). Я пытался изменить почти все, но все закончилось тем, что я выдавал ошибки во время выполнения. Я даже изменил имена переменных для Footer_Bild_Einfuegen() потому что я думал, что они могут объединить оба макроса по любой причине (нет ошибки времени выполнения, просто не сработало. Все закончилось так же, как и при одинаковых именах переменных).

Все работает нормально под Windows, но не работает под Mac. Я понятия не имею, чем это может быть вызвано, может быть, это просто внедрение VB в версии Mac-Office (MS Office 2008 для Mac, MS Office 2016 тоже не работает), я не знаю.

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

Спасибо заранее, ценю каждый ответ