Bild von Zelle (Excel) in Word Kopfzeile
17.11.2021 11:32:32
Zelle
Es geht um Folgendens:
In einem Excel - Blatt befindet sich ein Bild in einer Zelle, dieses Bild soll per VBA in ein Word-Dokument in die Kopfzeile (Position links) eingefügt werden.
Meine bisherigen "Versuche" sind beigefügt.
Ich hoffe, dass mir jemand hierbei helfen kann.
Danke!
Sub CreateWord()
Dim wordApp As Word.Application
Dim Cdoc As Word.Document
Dim xlSht As Excel.Worksheet: Set xlSht = ActiveSheet
Dim wordRng As Word.Range
Dim wSection As Section
Dim shp As Object
Dim hLogo As Excel.Shape
Dim hText As Excel.Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wordApp = New Word.Application
wordApp.Visible = True
Set Cdoc = wordApp.Documents.Add 'create new document
'Set wordRng = .Headers
'Kopfzeile
'For Each wSection In Cdoc.Sections
'With wSection.Headers(wdHeaderFooterPrimary)
'ThisWorkbook.Worksheets("Tabelle1").
'Cdoc.Content.InsertAfter Range("C1")
'Range("B1").Copy
'.Range.Paste
'End With
'Next wSection
' Sub Kopfzeile()
'With ActiveSheet.PageSetup
' .LeftHeader = Sheets("Tabelle1").Range("B1").Value
'End With
'End Sub
'copy from xl
Set hLogo = xlSht.Shapes("Grafik 4")
Set hText = xlSht.Range("E1")
'copy/paste logo
hLogo.Copy
'Cdoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Cdoc.Paragraphs(Cdoc.Paragraphs.Count).Range.PasteSpecial Link:=False, DataType:=wdPasteShape, Placement:=wdInLine, DisplayAsIcon:=False
'Cdoc.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
'For Each wSection In Cdoc.Sections
' With wSection.Headers(wdHeaderFooterPrimary)
' .Range.CopyAsPicture
' End With
'Next
'With ActiveSheet.PageSetup
' .LeftHeaderPicture.
' .LeftHeader = "&G"
'End With
End Sub