how to insert logo in word document as header by excel vba

[Nipendra.dhiman]

Sorry if this sounds dumb,
is there any way to insert a company logo in word document as a header by excel vba code and I have logo(picture) in the same excel file.


Thanks n advanced
Regards
Nipendra

 

[lohithsriram]

Hi Nipendra,

Do you want to create a new word document and insert the logo in it? or you have the list of Word documents in which the logo need to be inserted?

This is possible, just that you need to give more clarification on
1) New document or used docs
2) How are these logos stored in Excel (Picture1, Picture2 etc.,)

 

[Nipendra.dhiman]

thanks for your valuable reply....

I am working on a excel vba project where I am creating a word document.
now I need to insert a logo for the same document, and this logo is already saved in my one of excel sheets.

for more clarification I am attaching here a example file..

let me know if any confusion.

Regards
Nipendra

 

[Nipendra.dhiman]

Lohith i am almost in...the final,

but facing an error
what I am doing to get it..


Dim rng As Range "creating a variable as range type"
Sheets("data").Shapes(1).Copy "coping the logo from excel sheet "
worddoc.Activate
worddoc.Paragraphs(worddoc.Paragraphs.Count).Range.PasteSpecial "Paste on to new word document"
With worddoc
.Paragraphs(worddoc.Paragraphs.Count).Range.Select "select this shapes from word document"
Selection.Copy "copy the select shape"
With worddoc.Sections(1)
Set rng = .Headers(1).Range "call word header properties in to rng variable"
rng.Paste "paste shaped in to rng variable"

End With
End With

but facing an "error'13 type mismatch error"

please help me out

let me know if any confusion.

Regards
Nipendra

 

[lohithsriram]

Hey Nipendra,

Try this code please.

Sub OpenWordDoc()
'In order to use this code you must set a reference to the
'Word object library by doing this. In the VB Editor click
'Tools, References. Then search for Microsoft Word n.n Object Library
'where n.n will depend on your version of Word.

Dim wdApp As Word.Application, wdDoc As Word.Document

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

ActiveSheet.Shapes("Picture 1").Copy

Set wdDoc = wdApp.Documents.Open(ActiveWorkbook.Path & "\Output document.docx")
With wdApp
.Visible = True
wdDoc.Activate
'Change the view to header & footer
If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
.ActiveWindow.Panes(2).Close
End If
If .ActiveWindow.ActivePane.View.Type = wdNormalView Or wdApp.ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
.ActiveWindow.ActivePane.View.Type = wdPrintView
End If
'Select the Header range
.ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Select

.ActiveWindow.View.Type = wdPrintView
'paste the copied picture.
.Selection.PasteAndFormat (wdPasteDefault)
'Set the word view back to print mode.
.ActiveWindow.View.Type = wdNormalView
.ActiveWindow.View.Type = wdPrintView

End With
End Sub

 

[lohithsriram]

Sorry.. I didn't see your earlier post. Try my code and see if that works for you. Otherwise, I will try to improvise on yours. Thanks.

 

[Nipendra.dhiman]

Dear Lohith, glad to see your reply and appreciate your efforts but my requirement is little bit different may be it is perfect understandable in above post please help me out if you can.

Regards
Nipendra

 

[lohithsriram]

Hi Nipendra,

Is it possible to upload the sample file with the code you have done so far. I will give a try to fix it up. Thanks.

 

[Nipendra.dhiman]

I have done it dear thanks for your input and reply I will share it later on