inserire immagine intestazione word

Hai un problema con Excel?

Nuova discussione

inserire immagine intestazione word
di Salvo18 (utente non iscritto) data: 08/07/2015 10:18:11
ciao a tutti,
devo inserire un'immagine nell'intestazione di un documento word tramite codice vba excel. Ho provato questo codice ma inserisce l'immagine in una casella di testo. La cosa andrebbe anche bene ma non riesco a togliere il bordo nero della casella. Come posso fare? esistono soluzioni migliori per piazzare l'immagine nell'intestazione? grazie

Dim WApp As Word.Application
Dim WDoc As Word.Document
Dim WRng As Word.Range
Dim calc
Set WApp = New Word.Application
WApp.Visible = False

Filename = "C:Userssalvatore.marcheseDesktopimg1	est1.docx"

Set WDoc = WApp.Documents.Add
WDoc.SaveAs Filename

Set WRng = WDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
WDoc.Shapes.AddTextbox(msoTextOrientationHorizontal, 190#, 5#, 200#, 40#).Select

'Selection.ShapeRange.Line.Visible = msoFalse   'qui dà errore! non riconosce la proprietà!

ThisWorkbook.Sheets("Foglio1").Shapes("Immagine1").Select
Selection.Copy
WApp.Selection.PasteSpecial Link:=False, DisplayAsIcon:=False, _
            DataType:=wdPasteMetafilePicture, Placement:=wdFloatOverText

'''altra soluzione non funzionante:
'Set calc = WDoc.Shapes.AddOLEControl("Forms.Image.1", 0, 0, 100, 100)
'With calc.OLEFormat.Object
'.Picture = LoadPicture("C:Userssalvatore.marcheseDesktopimg1Salvo.jpg") 'qui darebbe errore! non riconosce la proprietà picture
'End With

WDoc.Close
WApp.Quit
Set WRng = Nothing
Set WDoc = Nothing
Set WApp = Nothing

di Vecchio Frac data: 08/07/2015 13:40:42
Se sei in Excel e stai pilotando Word, la riga
'Selection.ShapeRange.Line.Visible = msoFalse 'qui dà errore! non riconosce la proprietà!
si riferisce a Excel, non a Word.
Così a naso (non ho provato), dovresti creare l'oggetto Shape in Word attribuendogli un nome e poi riferendoti ad esso per impostarne la proprietà:

Set textbox = WDoc.Shapes.AddTextbox(msoTextOrientationHorizontal, 190#, 5#, 200#, 40#) textbox.ShapeRange.Line.Visible = msoFalse

Per sistemare un'immagine in intestazione (Header), potresti anche utilizzare una tabella e inserire l'immagine in una cella della tabella.
E' molto strano poi che Picture non funzioni visto che a me non dava problemi nella scorsa discussione. Non ricordo se ti ho già chiesto che versione di Word utilizzi.

di Vecchio Frac data: 08/07/2015 14:55:59
Scusa Salvo, avevo letto e capito male.
Volevi togliere il bordo all'immagine in Excel e poi trasferirla in Word.
Perchè aggiungi un textbox a Word dentro cui inserire l'immagine?
L'incollare semplicemente l'immagine nell'header (WRng) a me funziona.

Sub test()
Dim WApp As Object
Dim WDoc As Object
Dim WRng As Object
Dim filename As String
    
    Set WApp = CreateObject("word.application")
    WApp.Visible = False
    
    filename = "C:Users5314495Desktoppippo	est1.docx"
    
    ThisWorkbook.Sheets("Foglio1").Shapes("Immagine 1").Select
    Selection.Copy
    
    Set WDoc = WApp.Documents.Add
    WDoc.SaveAs filename
    
    Set WRng = WDoc.Sections(1).Headers(1).Range                'wdHeaderFooterPrimary
        
    WRng.PasteSpecial Link:=False, DisplayAsIcon:=False, _
                DataType:=3, Placement:=1         'wdPasteMetafilePicture, wdFloatOverText
    
    WDoc.Close True
    WApp.Quit
    Set WRng = Nothing
    Set WDoc = Nothing
    Set WApp = Nothing
End Sub

di Salvo18 (utente non iscritto) data: 09/07/2015 10:07:50
Per quanto riguarda il codice:
Set textbox = WDoc.Shapes.AddTextbox(msoTextOrientationHorizontal, 190#, 5#, 200#, 40#)
textbox.ShapeRange.Line.Visible = msoFalse
non funziona in quanto non riconosce comunque la proprietà dell'oggetto shape.

Il codice proposto in seguito funziona grazie mille. Come faccio però a posizionare l'immagine al centro dell'intestazione? o dopo un segnalibro inserito nell'intestazione?

Grazie
Salvo
di Salvo18 (utente non iscritto) data: 09/07/2015 10:40:33
Provo a Fare così ma il Placement:=0 (wdinLine) non gli piace e mi da un errore di automazione (la chiamata di procedura remota non riuscita) run time '-2147023170(800706be)
WDoc.Sections(1).Headers(1).Range.Bookmarks("Free").Select WApp.Selection.PasteSpecial Link:=False, DisplayAsIcon:=False, _ DataType:=3, Placement:=0

di Vecchio Frac data: 09/07/2015 14:20:44
Ti suggerisco il codice seguente, che inserisce nell'intestazione una tabella 1x3 e nella cella di mezzo piazza l'immagine, quindi la centra nella cella.

Option Explicit

Sub test()
Dim WApp As Object
Dim WDoc As Object
Dim WRng As Object
Dim filename As String
    
    Set WApp = CreateObject("word.application")
    WApp.Visible = False
    
    filename = "C:Users5314495Desktoppippo	est1.docx"
    
    ThisWorkbook.Sheets("Foglio1").Shapes("Immagine 1").Select
    Selection.Copy
    
    Set WDoc = WApp.Documents.Add
    WDoc.SaveAs filename
    
    Set WRng = WDoc.sections(1).headers(1).Range
    
    With WDoc.sections(1).headers(1).Range
        .Tables.Add WDoc.sections(1).headers(1).Range, 1, 3
        .Tables(1).Cell(1, 2).Range.PasteSpecial
        .Tables(1).Cell(1, 2).Range.ParagraphFormat.Alignment = 1        'center
    End With

    WDoc.Close True
    WApp.Quit
    Set WRng = Nothing
    Set WDoc = Nothing
    Set WApp = Nothing
    
End Sub

di Salvo18 (utente non iscritto) data: 09/07/2015 15:49:41
ottimo così funziona! se il documento word già esiste? ho provato a cambiare
Set WDoc = WApp.Documents.Add
con
Set WDoc = WApp.Documents.Open(filename)
ma mi dà errore di run time 6028

grazie
Salvo

di Vecchio Frac data: 09/07/2015 16:06:38
Bè puoi sempre controllare prima se il file esiste oppure no.
Un modo per farlo è usare Dir (ma si potrebbe provare anche con GetObject).
La gestione dell'errore seguente serve per eliminare la tabella creata in intestazione e ricrearla.
Se serve mantenerla in caso di accesso al file dopo che è stato creato, va studiata una soluzione diversa.

Sub test()
Dim WApp As Object
Dim WDoc As Object
Dim WRng As Object
Dim filename As String
    
    Set WApp = CreateObject("word.application")
    WApp.Visible = False
    
    filename = "C:Users5314495Desktoppippo	est1.docx"
    
    If Dir(filename) <> "" Then
        Set WDoc = WApp.documents.Open(filename)
    Else
        Set WDoc = WApp.documents.Add
    End If
    
    ThisWorkbook.Sheets("Foglio1").Shapes("Immagine 1").Select
    Selection.Copy
    
    
    WDoc.SaveAs filename
    
    Set WRng = WDoc.sections(1).headers(1).Range
    
    With WDoc.sections(1).headers(1).Range
        On Error Resume Next
        .tables(1).Delete
        On Error GoTo 0
        .tables.Add WDoc.sections(1).headers(1).Range, 1, 3
        .tables(1).Cell(1, 2).Range.PasteSpecial
        .tables(1).Cell(1, 2).Range.ParagraphFormat.Alignment = 1        'center
    End With

    WDoc.Close True
    WApp.Quit
    Set WRng = Nothing
    Set WDoc = Nothing
    Set WApp = Nothing
    
End Sub

Vuoi Approfondire?