Vanuit database Excel een offerte in Word maken dmv Macro

[MultiSP]

Hoi Allemaal,

Ik heb een lastige vraag:

Ik heb een database (welke zijn gegevens uit een gegevensbak haalt) met klantgegevens zoals naam, adres, tel nr., email, land, opslaglocatie offerte's etc.
Ik probeer een macro te maken om aan de hand van een zoeknaam (bv SCHHAM = Schneider Hamburg dus altijd 6 letters) of het debiteuren nummer
(6 cijfers) een offerte te maken.

Het liefst zie ik dat bij het openen een scherm opent en daarin de volgende vragen doorlopen worden:

Vraag 1: Verkoper (dus de naam van degene die de offerte schrijft) met een keuzelijst
Vraag 2: Zoeknaam of Debiteur nummer (1 van beide opties waarna op zoek gedrukt kan worden en de juiste debiteur gevonden wordt uit de database).
Vraag 3: Offerte = 10 invulvelden onder elkaar waar in elk veld uit een lijst met producten het product geselecteerd kan worden waarvoor een offerte nodig is.
Een knop om verder te gaan naar scherm 4. Er moeten dus van 1 tot 10 producten geselecteerd kunnen worden
Vraag 4: Verwerken. Dit wordt het moeilijkste denk ik. De macro doet achtereenvolgens het volgende:

1. Nieuw worddocument openen met een specifieke template (normal2.dot).
2. Per locatie gegevens invullen in het word document (denk via een bookmark of find/replace waarbij ik een numerieke waarde in de juiste plaats zet in de template)
3. Per geselecteerd product het bijbehorende word document openen, de text daarin kopieren, en deze text op een specifieke plek in het nieuwe word document plakken.
4. Als er maar 3 producten geselecteerd zijn kopieerd hij bij 4 t/m 10 niets.
5. Het bestand opslaan op een vaste locatie. Deze is bv. altijd: g:\contacten\duitstalig\(zoeknaam)\offertes\SCHHAM0001.doc Hierbij haalt hij de gegeven (zoeknaam) uit de database.
Het opgeslagen document moet opvolgend genummerd worden (de macro moet checken welk volgende nummer vrij is, dus de tweede wordt dan SCHHAM0002).
6. Klaar. Het nieuwe wordt document is opgeslagen maar blijft open staan om de laatste zaken te finetunen. De documenten met sjablonen zjin afgesloten. Het excel bestand sluit zichzelf ook zonder op te slaan.

Heb al een macro welke een bestand kan openen gebaseerd op een andere template, maar kom niet echt verder ermee. Tevens doe ik dat nu met een knop in een werkblad, niet met een venster.

Hoop dat kullie me kunnen helpen hiermee en wat voorbeelden hebben per functie en/of uitvoer gedeelte. Ik zal dan zelf mjin best doen om alles in elkaar te zetten.

Groeten Sjoerd

 

[MultiSP]

Ik heb al enkele dingen voor elkaar.

Hij opent een WORD document, en slaat deze op in de juiste locaties (om precies te zijn g:\relaties\contacten\duitstalig\(zoeknaam)\Offertes\ als een document met als naam: (zoeknaam0001.doc

Om verder te gaan, hoe kan ik een nieuw worddocument laten aanmaken op basis van een ander sjabloon (dus bv. normal2.dot ipv normal.dot). En hoe laat ik controleren of de bestandsnaam al bestaat?

Hier de code tot zover:

Sub CreateNewWordDoc()
'This routine will export a range to a Word document
'It opens Word, paste the Excel range, stores the Word document in the correct location

    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
    
       'Find the path to "G:\RELATIES\Contacten\duitstalig\.Range("B4")\offertes
    Set oWSH = CreateObject("WScript.Shell")
    sPath = "G:\RELATIES\Contacten\duitstalig\" & Worksheets("Angebot").Range("B24")
    
        '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("B4") & "0001"
       
    'Create a Word document.
    Set oWordApp = CreateObject("Word.Application")

    'Make the newly created Word instance visible
    oWordApp.Visible = True
     
    'Create a new document
    Set oWordDoc = oWordApp.Documents.Add
       
    'Save the Word document
    oWordDoc.SaveAs sPath & sFileName, wdFormatDocument


End Sub

De juiste bestandsmap verkrijg ik door TEXTSAMENVOEGEN toe te passen op de zoeknaam (waarde cel B4) en daarbij \Offertes\ aan toe te voegen.

 

[OctaFish]

Je moet de template aan het commando toevoegen:

    Set oWordDoc = oWordApp.Documents.Add Template:="C:\Program Files\Microsoft Office\Templates\1033\MergeLetter.dot

 

[snb]

Als je een Word hoofddocument samenvoegen maakt kan het veel eenvoudiger:
Dat hoofdcoument fungeert dan als 'sjabloon'.
Na het samenvoegen sluit het hoofddocument zonder wijzigingen op te slaan; daarmee blijft het ongerept.

Sub snb()
  with Getobject("G:\OF\samenvoeg.doc")
    .mailmerge.execute
    with .application.activeworkbook
      .saveas "G:\OF\offerte 002.doc"
      .close 0
    end with
    .close 0
  end with
end sub

 

[MultiSP]

Nou, ben weer een stukje verder. Hij opent een nieuw wordbestand op basis van een sjabloon. Tevens heb ik in Excel de code zover dat hij of op zoeknaam zoekt in een database, of op klanten nummer.
Deze info gebruikt hij dan om velden te vullen met de naam, adres, contact gegevens etc. Nu een belangrijke.

Hoe plak ik een waarde uit excel, als text en dus niet als tabel, op een specifieke plek in het Word document. Hier heb ik nog geen idee over?? Hoop dat iemand een mooi stukje code heeft voor me.

 

[snb]

Die vraag was al beantwoord: gebruik een Word samenvoeg hoofddocument (mail merge)

 

[MultiSP]

Nog niet beantwoord

Nee de vraag is niet beantwoord.

Ik wil geen hele stapel brieven maken met verschillende adreshoofden. Ik wil voor 1 klant een specifieke offerte samenstellen. Wij hebben sjablonen in 4 talen voor ongeveer 80 verschillende producten. Ik wil dus in 10 keuzevensters een keuze laten maken uit maximaal 10 producten. Aan de hand van die keuzes opent Excel dan de bijbehorende Word documenten, kopieert de text (dus de productomschrijving) en plakt deze in het actieve word document op een vastgestelde plaats (search/replace). Als er niets geselecteerd wordt in een venster plakt Excel er een lege regel.

Het Excel bestand doet het volgende al:

1. Door het ingeven van een zoeknaam of debiteuren nummer de benodigde debiteurgegevens uit de gegevensbak halen.
2. Een Word document aanmaken op basis van een sjabloon.
3. Dit Word document opslaan in de offertemap van de opgezochte debiteur.
4. Opslaan als zoeknaam0001.doc Dit moet echter aangepast worden zodat hij altijd het volgende nummer pakt.

Wat ik nu nog moet doen:

5. Lijstjes maken met de te selecteren producten, kan ik prima zelf.
6. Een search/replace code schrijven om waardes in een cel in het word document te plakken op een specifieke plaats. Dit wordt lastig voor me, hier heb ik graag hulp bij

Alvast bedankt iedereen,

Gr. Sjoerd

 

[snb]

Je vraag is al beantwoord: een mail merge kan uit 2000 documenten bestaan, maar ook uit 1.
De ingebouwde systematiek blijft hetzelfde.
Gebruik ingebouwde faciliteiten van de programma's die je gebruikt voordat je zelf een overbodig, en waarschijnlijk niet erg rond wiel gaat uitvinden.

 

[MultiSP]

Ok dank je wel. Heb er eens goed naar gekeken en hoe ik met een mailmerge adresgegevens etc vanuit excel in het word sjabloon krijg is me duidelijk.

Maar hoe kan ik kiezen uit verschillende productomschrijvingen, die allemaal in het eigen word document staan? Ik kan in word toch geen selectiemenu zetten oid??
Deze productomschrijvingen zijn allemaal verschillend in aantal regels e.d. Wel allemaal in dezelfde layout en regelafstanden.

 

[snb]

Maar hoe kan ik kiezen uit verschillende productomschrijvingen, die allemaal in het eigen word document staan? Ik kan in word toch geen selectiemenu zetten oid??

Tuurlijk wel.

 

[MultiSP]

Hey,

daar ben ik weer met een update.
Ben al redelijk ver nu. De code is zover dat hij alles doet nu. Dus debiteur gegevens opzoeken in gegevensbak, Word sjabloon openen, debiteur gegevens plakken in bookmarks in sjabloon,
Word document opslaan is de juiste map van de debiteur. Daarna opent en kopieert hij de gekozen productdocumenten en plakt deze informatie in de offerte op de juiste plaats.

Wil echter nog 1 ding toevoegen. Ik wil laten checken of de ingevoerde bestandnaam welke opgebouwd is uit een aantal cellen in Excel al bestaat in de doelmap. Ik denk dat dit gedeelte
moet komen voordat het nieuwe document aangemaakt wordt, anders heb je een document openstaan als de macro stopt. De macro moet dus stoppen en een prompt geven "Offerte bestaat al"
met een OK knop als de bestandsnaam al bestaat. Bestaat deze niet, dan moet de rest van de macro uitgevoerd worden. Hebben jullie enig idee hoe ik dit erin krijg.

Hier de code tot zover:

Sub CreateNewWordDoc()
'This routine will export a range to a Word document
'It opens Word, paste the Excel range, stores the Word document in the correct location

Dim oWordApp As Object
Dim oWordDoc As Object
Dim oWSH As Object
Dim rExport As Range
Dim sFileName As String, sPath As String

'Find the path to "G:\RELATIES\Contacten\duitstalig\.Range("B4")\offertes
Set oWSH = CreateObject("WScript.Shell")
sPath = "G:\RELATIES\Contacten\" & Worksheets("Offertes").Range("S5")

'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 = Worksheets("Offertes").Range("F32") & Worksheets("Offertes").Range("B17")



'Check if the file already exists


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

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

'Create a new document
Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("S4"))

'Save the Word document
oWordDoc.SaveAs sPath & sFileName, wdFormatDocument

'Copy Excel range, go to Bookmark in Active word document and paste the value without formatting
Range("F20").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="bedrijfsnaam"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F31").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="contactpersoon"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F21").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="straatnaam"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F22").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="postcode"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F23").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="plaats"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F25").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="telefoon"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F26").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="fax"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F27").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="email"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F33").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="datum"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F28").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="klantnr"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F30").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="verkoper"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F29").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="offertenr"
oWordApp.Selection.PasteExcelTable False, False, True

Range("F34").Select
Selection.Copy
oWordApp.Selection.Goto What:=wdGoToBookmark, Name:="referentie"
oWordApp.Selection.PasteExcelTable False, False, True

'Open designated Word document from folder, copy content, close file, make open word document active and paste content on the right place of the bookmark
Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U4"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon1").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U5"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon2").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U6"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon3").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U7"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon4").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U8"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon5").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U9"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon6").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U10"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon7").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U11"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon8").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U12"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon9").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U13"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon10").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U14"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon11").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U15"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon12").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U16"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon13").Select
oWordApp.Selection.Paste

Set oWordDoc = oWordApp.Documents.Open("R:\70. TOOLS\CAS\" & Worksheets("Offertes").Range("U17"))

oWordApp.Selection.WholeStory
oWordApp.Selection.Copy
oWordDoc.Close
oWordApp.ActiveDocument.Bookmarks.Item("sjabloon14").Select
oWordApp.Selection.Paste

oWordApp.ActiveDocument.Save

End Sub