via VBA in Excel WORD openen met sjabloon

Status
Niet open voor verdere reacties.

sylvietoin

Gebruiker
Lid geworden
5 feb 2007
Berichten
56
Hallo,

Ik heb een probleempje,

Ik wil via EXCEL een nieuw WORD bestand maken met een bepaald SJABLOON (staat op c-schijf)
Daarna een range vanuit EXCEL in dit WORD bestand copieren.

Wat op dit moment wel werkt, is dat ik via EXCEL, WORD kan openen, maar dan zonder SJABLOON.

'Create a Word document.
Set oWordApp = CreateObject("Word.Application")

'Make the newly created Word instance visible
oWordApp.Visible = True

'create a new document ======> hoe krijg ik hier een nieuw doc. met SJABLOON ?
Set oWordDoc = oWordApp.Documents.Add

'Copy data
rExport.Copy

'Paste Excel range in Word (will be pasted in a table)
oWordApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine

Weet iemand raad?

Toin
 
Code:
Set oWordDoc = oWordApp.Documents.Open "PADNAARHETSJABLOON"

Graag ook code tags gebruiken op het forum aub, dat maakt het allemaal veel leesbaarder hier.

Wigi
 
Bedankt voor je code Wigi

Heb hem gewijzigd naar mijn sjabloon echter:

Ik krijg een foutmelding 449 argument niet optioneel

Ik heb daarna verschillende dingen geprobeerd:
(Ik ben een beginner in VBA dus niets is vanzelfsprekend)

1:

Code:
 'OPEN (create) a new document
    Set oWordDoc = oWordApp.Documents.Open = "C:\test-1.dot" _    ===> . DOT
    , NewDocument:=False, DocumentType:=0

2:

Code:
'OPEN (create) a new document
    Set oWordDoc = oWordApp.Documents.Open = "C:\test-1.doc" _    ===> .DOC !
    , NewDocument:=False, DocumentType:=0

M.b.v. help kom ik er ook niet uit

misscien dat je mij verder kunt helpen.en of dat je fouten ziet in de hieronder staande VBA



Code:
Sub Verzendadvies()


'This routine will export a range to a Word document with sjabloon
'It opens Word, paste the Excel range, stores the Word document and closes the Word application

    Dim oWordApp As Object
    Dim oWordDoc As Object
    Dim oWSH As Object
    Dim rExport As Range
    Dim sFileName As String, sPath As String
    Dim i As Long, i2 As Long
    
    Set rExport = Worksheets("verzendadvies").Range("c9:j51")      '<- Change as needed

    'Find the path to "C:/8606/VERZENDADVIEZEN"
    Set oWSH = CreateObject("WScript.Shell")
    sPath = "c:\" & Worksheets("verzendadvies").Range("d29") & "\" & "verzendadviezen\"
    
    'Assemble a filename for the Word document
    'In this case use the value that is in the first cell of the exported range and append date
    sFileName = Range("d29") & "-" & "verzendadvies"
    
       'Optional: make sure you have a unique filename
    i = 1
    While FileExists(sPath & "\" & sFileName & ".doc")
        i2 = InStr(1, sFileName & ".doc", "(", vbTextCompare)
        If i2 = 0 Then
            sFileName = sFileName & "(" & i & ")"
        Else
            sFileName = Left(sFileName & "verzendadvies.doc", i2) & i & ")"
        End If
        i = i + 1
    Wend
    'Create a Word document.
    Set oWordApp = CreateObject("Word.Application")

    'Make the newly created Word instance visible
    oWordApp.Visible = True
     
    'OPEN (create) a new document
    Set oWordDoc = oWordApp.Documents.Open = "C:\test-1.dot"
    
    'Copy data
    rExport.Copy
     
    'Paste Excel range in Word (will be pasted in a table)
    oWordApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine
   
    'Save the Word document
    oWordDoc.SaveAs sPath & sFileName, wdFormatDocument
    
    'Close Word Application
    oWordApp.Quit SaveChanges:=False
   
End Sub

Code:
'FileExists Function -> geeft TRUE terug als de file bestaat
Function FileExists(fname As String) As Boolean
  FileExists = Dir(fname, vbNormal) > Empty
End Function

Alvast bedankt!

Toin
 
Laatst bewerkt door een moderator:
Dit kan al zeker niet:

Code:
Set oWordDoc = oWordApp.Documents.Open = "C:\test-1.dot"

dit heeft meer kans op succes

Code:
Set oWordDoc = oWordApp.Documents.Open("C:\test-1.dot")

ongetest

Wigi
 
Deze doet wat je wil.
Zorg dat Word al geladen is.

Code:
Sub tst()
  With GetObject(, "Word.Application").documents.Add("C:\test-1.dot")
     .application.visible=true
   End With
End Sub
 
Dank je Wigi,

maar wat ik eigenlijk dacht te bereiken lukt hiermee niet.

Wat ik dacht is het volgende:

ik zit in EXCEL via VBA open ik WORD met een SJABLOON met in de koptekst de naam van het bestand, (BESTANDSNAAM) dat ik later wil gaan opslaan onder een andere naam.
(Het sjabloom moet natuurlijk blijven zoals het was)

Wat blijkt nu,

1: Via EXCEL open (of wijzig = add) ik het bedoelde sjabloon.
2: insert de range
3: sla het bestand op met een unieke naam.

Wat blijkt nu:

A: in het bedoelde sjabloon (TEST-1) is in de koptekst nu (zonder dat ik dat wil) selectie BESTANDSNAAM gewijzigd in AUTOTEKST FRAGMENT INVOEGEN.

Is deze selectie niet op een of andere manier vast te zetten o.i.d. ?

Is er misschien een andere mannier om bovenaan mijn blad de naam van het bestand te krijgen?


Toin
 
De suggestie van WiGi opent het sjabloon en wijzigt dat.
Met mijn suggestie wordt een nieuw document gemaakt op basis van het sjabloon. Alle wijzigingen in het bestand hebben geen invloed op het sjabloon.
 
VBA code tussen de codetags geplaatst zodat het beter leesbaar wordt voor de helpers.
 
Dank je SBN en Wigi voor jullie hulp,

SNB,

Ik heb je code toegevoegd, maar doet niet wat ik wil.

Kun jij mij vertellen waar ik precies jouw toegevoegde code moet plaatsten, en welke code moet ik weghalen en waarom?

A: Ik heb de code geplaatst na

Code:
        i = i + 1
    Wend
    'Create a Word document.


Macro stopt en geeft compileerfout precies waar ik jouw code heb ingevoegd.

B: Vervolgens geprobeerd:

Code:
Set oWordApp = CreateObject("Word.Application")

weggehaald.

Blijft zelfde compileerfout geven.


Code:
    'Find the path to "C:/8606/VERZENDADVIEZEN"
    Set oWSH = CreateObject("WScript.Shell")
    sPath = "c:\" & Worksheets("verzendadvies").Range("d29") & "\" & "verzendadviezen\"
    
    'Assemble a filename for the Word document
    'In this case use the value that is in the first cell of the exported range and append date
    sFileName = Range("d29") & "-" & "Verzendadvies"
    
       'Optional: make sure you have a unique filename
    i = 1
    While FileExists(sPath & "\" & sFileName & ".doc")
        i2 = InStr(1, sFileName & ".doc", "(", vbTextCompare)
        If i2 = 0 Then
            sFileName = sFileName & "(" & i & ")"
        Else
            sFileName = Left(sFileName & "verzendadvies.doc", i2) & i & ")"
        End If
        i = i + 1
    Wend
    'Create a Word document.
    Set oWordApp = CreateObject("Word.Application")
      
      Sub tst()
  With GetObject(, "Word.Application").documents.Add("C:\test-1.dot")
     .Application.Visible = True
   End With
End Sub
      
    'Make the newly created Word instance visible
    oWordApp.Visible = True
     
    'Create a new document
    Set oWordDoc = oWordApp.documents.Add
     
    'Copy data
    rExport.Copy
     
    'Paste Excel range in Word (will be pasted in a table)
    oWordApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine
   
    'Save the Word document
    oWordDoc.SaveAs sPath & sFileName, wdFormatDocument
    
    
    'Close Word Application
    oWordApp.Quit SaveChanges:=False
   
End Sub

Misschien weet jij raad?

Toin
 
Vervang de volledige code in je vorige bericht door:

Code:
Sub opslag()
    rExport.Copy
   With GetObject(, "Word.Application").documents.Add("C:\test-1.dot")
     .Selection.PasteSpecial    
    .SaveAs "c:\" & Worksheets("verzendadvies").Range("d29") & "\" & "verzendadviezen\" & Worksheets("verzendadvies").Range("d29") & "-" & "Verzendadvies.doc"
    .Close 
   End with
End Sub
 
Dank je SNB,


maar......

Dit is niet wat ik wil, (in de koptekst verschijnt de naam van het sjabloon, i.p.v. mijn bestandsnaam)

in mijn sjabloon had ik bij koptekst de selectie BESTANDSNAAM geslecteerd,
ik ging er vanuit dat deze selectie automatisch zou blijven bestaan.
(gebeurt dus niet)

In de koptekst springt de selectie terug naar AUTOTEKST FRAFMENT INVOEGEN.

Dit gebeurt dus ook weer met jouw code.

Wat ik nu heb geprobeerd, is:

1; In WORD macro opgenomen voor het wijzigen van de koptekst naar BESTANDSNAAM
2: koptekst sluiten
3: macro beeindigen
4: Deze VBA overgenomen in EXCEL na

Code:
    'Create a new document
    Set oWordDoc = oWordApp.Documents.Add


en voor:

Code:
    'Copy data
    rExport.Copy

Echter de macro loopt vast op eerste regel van nieuw opgenomen macro in WORD.
Wat doe ik niet goed?
Voer ik in WORD de macro uit, dan doet de macro wel wat ik bedoel. ??


Opgenomen macro in WORD:

' Voorziet word bestand van koptekst (bestandsnaam)

Code:
    If ActiveWindo.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    NormalTemplate.AutoTextEntries("Bestandsnaam").Insert Where:=Selection. _
        Range, RichText:=True
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Wie weet nogmaals raad?

Toin
 
Zet in het sjabloon in de kopteskt het veld filename: Menu/invoegen/veld.../documentgegevens/filename.
In de code hoef je dan alleen, nadat je het bestand een naam hebt gegeven het veld te laten bijwerken.
Zie de bijlage voor een voorbeeldsjabloon.

Code:
Sub opslag()
    rExport.Copy
   With GetObject(, "Word.Application").documents.Add("C:\test-1.dot")
     .Selection.PasteSpecial    
    .SaveAs "c:\" & Worksheets("verzendadvies").Range("d29") & "\" & "verzendadviezen\" & Worksheets("verzendadvies").Range("d29") & "-" & "Verzendadvies.doc"
    .StoryRanges(wdPrimaryHeaderStory)
    .Close 
   End with
End Sub
 

Bijlagen

Laatst bewerkt:
Nou dank je SNB,

maar ik snap er intussen nog minder van...

wat ik geprobeerd heb is het volgende:

1: jouw WORD bijlage hernoemd naar test-1 op C:\
Overigens heb ik eerst in mijn template geprobeerd wat jij opgaf in jou laatste reactie:
om de bestandsnaam weer te geven in WORD bestand

= Via kop- voettekst autotekst-fragment invoegen
= Bestandsnaam ( ik zie geen veld staan)

Dus vervolgens geprobeerd via pull-down menu:

* Invoegen
* Veld
* Autotekst
* Bestandsnaam

Is dit juist?


2: jou code ingevoegd na:

Code:
    'Create a Word document.
    Set oWordApp = CreateObject("Word.Application")

echter heb ik jouw macro ingevoegd IN mijn macro dus VERZENDADVIES

dus:

sub () weggehaald
en
end sub weggehaald

Wat er gebeurt is:

A: dat inderdaad WORD wordt geopend

B: plus vervolgens jouw bijlage met inderdaad naamgeving document-1
(maar volgens mij zou dit dan moeten zijn:: Range("d29") & "-" & "\" & "Verzendadviezen\" == (UNIEKE NAAM)==

C: de range uit EXCEL wordt echter niet meer ingevoegd

Ik krijg foutmelding

fout 438, deze eigenschap of methode wordt niet ondersteund door dit prjoject

Ik werk overigens met 2003

de foutaanwijzing geeft fout op regel: Selection pasteSpecial


'Copy data
rExport.Copy
With GetObject(, "Word.Application").documents.Add("C:\test-1.dot")
Code:
.Selection.PasteSpecial
.SaveAs "c:\" & Worksheets("verzendadvies").Range("d29") & "-" & "\" & "Verzendadviezen\" & Worksheets("verzendadvies").Range("d29") & "-" & "Verzendadvies.doc"
.StoryRanges (wdPrimaryHeaderStory)
.Close
End With


Help!

Toin
 
Ik heb het nooit over een autotekstfragment maar altijd over een veld gehad.

Wat moet je doen:

hernoem mijn bijlage als C:\test-1.dot
Draai deze macro vanuit een Excel werkboek.

Code:
Sub opslag()
  With GetObject(, "Word.Application").documents.Add("C:\test-1.dot")
    .SaveAs "C:\Verzendadvies 001.doc"
    .StoryRanges(wdPrimaryHeaderStory).Fields.Update
    .Close 
  End with
End Sub
Open daarna het bestand "C:\Verzendadvies 001.doc" en kijk naar de koptekst.
 
Nogmaals bedankt SNB,

Ik begrijp eigenlijk nog steeds niet wat je precies bedoelt met VELD.

maar heb je raad opgevolgd,

1; Nieuw EXCEL bestand gemaakt. (map1 op c-schijf)
2: Jouw macro OPSLAG hierin gecopierd
3: Jouw word bestand op C:\ gezet en hernoemd test-1.dot

marco gedraaid,

Ik krijg echter foutmelding:

429
AxtiveX-onderdeel kan geen object maken.

Code:
With GetObject(, "Word.Application").documents.Add("C:\test-1.dot")

macro loopt vast op eerste regel.

Note:
Ik had in EXCEL verder geen andere macro's staan.


Vervolgens:

A: in mijn originele EXCEL bestand jouw macro gecopierd: (onderaan)
B: macro gedraaid
C: zelfde probleem


Daarna:

* in mijn EXCEL bestand jouw macro gecopierd (onderaan)
* save as naam aangepast
.
Code:
SaveAs sFileName = Range("d29") & "-Verzendadvies"
* zelfde probleem.

Conclusie:

Ik zie door de bomen het bos niet meer.

Dus misschien dat jij mij verder kunt helpen door in mijn gehele macro een aanpassing te doen.

Note:

Voor draaien van mijn macro:

1: Op C:\schijf dir 7000 aanmaken
2; sub dir Verzendadviezen
 

Bijlagen

Zorg eerst dat Word geladen is, voordat je de macro in Excel draait.
Als je niet weet wat een veld is: heb je ooit wel eens gekeken in menubalk/invoegen/veld....
En........ verander niets aan de bestanden/macro's die ik stuur, behalve als ik dat aangeef.
 
Laatst bewerkt:
Dank je SNB,

Over wat je schrijft over het veld;
Dit had ik reeds eerder beschreven alleen ik wist niet zeker of je het op die mannier bedoelde.

Ik heb je raad opgevolgd:

1: ik heb WORD opgestart (niet bestand test-1.dot) dus blanco blad
2: jouw VBA gecopierd naar nieuw EXCEL bestand
3: marco gedraaid
4; foutmelding

vervolgens:

5: ik heb WORD opgestart (bestand test-1.dot geopend)
6: jouw VBA gecopierd naar nieuw EXCEL bestand
7: marco gedraaid
8; foutmelding

vervolgens:

1: ik heb WORD opgestart (niet bestand test-1.dot) dus blanco blad
2: jouw VBA gecopierd naar mijn EXCEL bestand (onderaan) ==> zou geen verschil moeten maken met vorige pogingen)
3: marco gedraaid (opslag)
4; foutmelding

vervolgens:

9: ik heb WORD opgestart (bestand test-1.dot geopend)
10: jouw VBA gecopierd naar mijn EXCEL bestand (onderaan)
11: marco gedraaid (opslag)
12; foutmelding

Jouw volledige code copieren in mijn macro en aanpassen heb ik niet gedaan.
Ik zou later wel graag hebben dat ik niet apart WORD hoef op te starten en dat de naam bovenaan het bestand gezet wordt met een druk op de knop. (dus eigenlijk ingevoegd in mijn macro)

Ik begrijp niet waarom de macro bij jou wel werk en bij mij niet!

Wat zie ik over het hoofd?
overigens werk ik met 2003

Ik zit nu te denken gezien de vruchteloze pogingen van mij, om niet een sjabloon te openen, maar;

na het invoegen van de range in WORD en het opslaan van het bestand met een unieke naam, de koptekst automatisch te laten invoegen

Wat ik heb gedaan:

A: WORD opgestart (blanco blad)
B: macro gestart
C: beeld
D: kop en voettekst
E: autotekst fragment invoegen
F: bestandsnaam
G: macro gestopt
H: geprobeerd of deze macro in WORD werkt (ja)
I: macro gecopierd naar EXCEL
J: ??

vanaf nu weet ik niet hoe ik de macro van WORD in EXCEL kan laten werken
oWordDoc. .....???

Code:
'koptekst in word document invoegen
 oWordDoc.Insert
 If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    NormalTemplate.AutoTextEntries("Bestandsnaam").Insert Where:=Selection. _
        Range, RichText:=True
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

    'Close Word Application
    oWordApp.Quit SaveChanges:=False

Misschien dat je mij nogmaals wilt verder helpen ?


Groetjes Toin
 
Ik had nog 2 fouten in mijn suggestie staan.

De juiste code is:

Code:
Sub opslag()
  With GetObject(, "Word.Application").Application.documents.Add("C:\test-1.dot")
    .SaveAs "C:\Verzendadvies 001.doc"
    .StoryRanges(7).Fields.Update
    .Close -1
  End With
End Sub
Zet die code in een nieuw Excelbestand.

Zorg dat mijn eerdere Wordbijlage C:\test-1.dot heet.
Het nieuwe bestand wordt opgeslagen als "C:\Verzendadvies 001.doc"
 
Dank je SNB,

code werkt inderdaad maar,

A: het openen van een sjabloon is prima.
B: het wegschrijven onder een unieke naam gebeurt nu niet (altijd verzendadvies001.doc
C: de code heb ik geprobeerd om aan te passen, zodat deze wel als unieke naam wordt weggeschreven (vruchteloos)

D: daarom, na opslaan van WORD bestand geprobeerd om de koptekst te krijgen.
E: Dit heb ik gedaan d.m.v. macro opnemen via

F: invoegen veld
G: document gegevens
H:Filename
I: Begin hoofdletter
J: pad aan bestandsnaam toegvoegen
K: ok

L: geprobeerd of deze macro in WORD werkt (ja)
M: macro gecopierd naar EXCEL

N: Nu heb ik op dit forum gelezen dat: om in de VBA code vanuit EXCEL naar de VBA code in WORD over te schakelen, je tussen with en end with een punt voor het commando moet zetten.
Zoals ik het begrijp zou je dus in WORD een macro op kunnen nemen, er een aantal punten aan toe moeten voegen om een werkende macro te krijgen.

Dus.. dat heb ik gedaan:


Code:
Sub Macro4()
'
' Invoegen koptekst
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "FILENAME  \* FirstCap \p ", PreserveFormatting:=True
End Sub

O: code ingevoegd in EXCEL na Save the Word document en aangepast

Code:
    'Save the Word document
    oWordDoc.SaveAs sPath & sFileName, wdFormatDocument
    
    ' Insert Koptekst
      With GetObject(, "Word.Application").documents.Add
    .Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "FILENAME  \* FirstCap \p ", PreserveFormatting:=True
End With
    'Close Word Application
    oWordApp.Quit SaveChanges:=False
   
End Sub


P: Ik krijg echter foutmelding op regel FILENAME

Code:
    .Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "FILENAME  \* FirstCap \p ", PreserveFormatting:=True


Q: Ik begrijp echter niet waarom.

Wie weet raad?

Toin
 
We bouwen alles op vanaf het begin: van eenvoudig naar complex.
Jouw vraag bevat diverse elementen.

Wat gebeurt nu:
  • vanuit Excel wordt een nieuw Worddocument aangemaakt
  • het nieuwe Worddocument is gebaseerd op een specifiek Word sjabloon
  • Het nieuwe Worddocument wordt onder een bepaalde naam opgeslagen.
  • In het nieuwe Worddocument wordt de naam van het bestand getoond in de koptekst.
daarmee is 80% van jouw wensen gerealiseerd.

Je hebt overigens nog niet begrepen dat in het wordsjabloon een veld in de koptekst staat, dat automatisch de naam van het bestand weergeeft. Al jouw pogingen om iets met een koptekst te doen zijn daarom overbodig.

Om het uit te testen houden we het eerst simpel (geen variabele documentnaam) om na te gaan of 80% van wat je wil correct verloopt.
Als dat het geval is - en dat blijkt uit je bericht- voegen we de volgende stap in.
De naam van het bestand wordt bepaald door de regel met SaveAs. Die gaan we dan aanpassen en dan zijn we (helemaal) klaar.

Code:
Sub opslag()
  With GetObject(, "Word.Application").Application.documents.Add("C:\test-1.dot")
    .SaveAs "C:\" & Worksheets("verzendadvies").Range("d29") & "\" & "verzendadviezen\" & Worksheets("verzendadvies").Range("d29") & "-" & "Verzendadvies.doc"
     .StoryRanges(7).Fields.Update
    .Close -1
  End With
End Sub

Omdat ik niet weet wat er in cel D29 van werkblad verzendadvies staat, loopt deze regel alleen maar goed als hier geen ongeldige tekens voor een bestandsnaam staan.

Tenslotte: je doet er verstandig aan je VBA kennis stap voor stap op te bouwen: van eenvoudig naar complex en pas een volgende stap te nemen als je alle vorige snapt. Zoek eens een VBA-cursus op Internet of koop een boek en spit dat systematisch door. Ik heb nu de indruk dat het verschil tussen wat je met VBA wil en je kennis van VBA veel te groot is.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan