Remélem kellemesen teltek az ünnepek és az idei év kicsivel derűsebb, kiszámíthatóbb lesz. A járvány miatt talán nektek is felszabadult egy kis extra időtök (pl. rokonlátogatások és utazások elmaradása, illetve csökkenése okán), amit remélhetőleg jól kihasználtatok.
2021 első posztjának lényege egy olyan makró, mely az Excelben lévő adatokat bemásolja egy Word sablon megfelelő részeibe.
Majd a sablont elmenti más néven Word, illetve PDF formátumban.
Mire jó ez? Hát például különféle tájékoztatók, árajánlatok, megrendelés visszaigazolások automatikus generálására.
Nézzük a lényeget animáció formájában:
Az Excel fájl struktúrája, amit frissítenünk kell és a Wordhöz szükséges adatokat tartalmazza:
Word sablon kiinduló állapot:
Természetesen a Word sablon szövegét, kinézetét lehet módosítani.
A makró futása után az egyik kitöltött Word fájl – mely Word és PDF formátumban is mentésre kerül
(a kitöltött adatok a fenti Exceles képernyő 2. sorából származnak):
A kulcsszó itt a Word sablonban lévő könyvjelző (bookmark), mely tulajdonképpen a dokumentum egy részére mutató hivatkozás. Például a „PartnerNeve” könyvjelzőnél:
Persze a könyvjelző által hivatkozott rész (ami itt a <Partner neve>) megváltoztatható, manuálisan vagy makróval. Hiszen a <Partner neve> helyett igazi neveket akarunk látni a Word fájlban.
A kód tehát végigmegy az Excel adott munkalapjának sorain:
- először az Excel 2. sorával kezd és pl. a <Partner neve> részt a Word sablonan kicseréli az ott lévő névre – itt “ABC Kft“-re. Majd ugyanezt megcsinálja a dokumentumban lévő többi névvel is. Miután ezzel végzett, a sablont elmenti más néven Word, illetve PDF formátumban
- következik az Excel 3. sora: a <Partner neve> részt a Wordben kicseréli az ott lévő névvel – itt már az “XYZ Bt“-re. Majd ugyanezt megcsinálja a dokumentumban lévő többi névvel is. Miután ezzel végzett, a sablont szintén elmenti más néven Word, illetve PDF formátumban
- és így tovább, nyilván az Excel állhatna több sorból is.
Vizuálisan:
Az Excelben az „F” oszlopban az aláírási kép teljes elérési útját kell megadnunk, a makró ugyanis innen emeli be az aláírást és teszi be a Word fájlba.
A Word sablonban itt hét könyvjelzőt hoztam létre, mely a sablon alábbi részeire hivatkozik:
Ha a Word sablon és a forrásadatokat tartalmazó Excel is rendelkezésre áll, az alábbi kódot kell bemásolni az Excel munkafüzet új moduljába és onnan futtatni:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 |
Sub Create_Word_and_PDF_Documents() Dim Wd As Word.Application, WdDoc As Word.Document, WordTemplFileName As String Dim WordTemplFileLocation As String, WordNewFileName As String Dim MyRange As Excel.Range, MyCell As Excel.Range Dim txtPartnerNeve As String, txtPartnerAdoszama As String, txtPartnerSzekhelye As String Dim txtPartnerMegszolitas As String, txtKeltezes As String, txtAlairasiKep As String, txtAlairasiNev As String Dim Sz As Long, Ido As String 'készítette: Tulner Roland (xlmotyo.hu) '************************************************************************************************************* 'makró futtatása előtt: Korai kötés miatt beállítani VBA szerkesztőben: 'Tools -> References -> Microsoft Word XX.0 Object Library (XX helyére: Word verziószáma, pl. 14 vagy 16) 'Tools -> References -> Microsoft Outlook XX.0 Object Library (XX helyére: Word verziószáma, pl. 14 vagy 16) '************************************************************************************************************* 'Word dokumentumok automatikus létrehozása makróval, előre megadott Word sablon használatával. 'Majd a word dokumentumok exportálása PDF formátumban. 'A makrót innen, Excel-ből kell futtatni. MsgBox "Tallózd ki a Word sablont", vbInformation, "" Application.FileDialog(msoFileDialogFilePicker).Show On Error GoTo Vege WordTemplFileName = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) WordTemplFileLocation = Left(WordTemplFileName, InStrRev(WordTemplFileName, "\")) 'kontakt lista tartományának megadása Sheet1.Select Set MyRange = Sheet1.Range("A2:A" & Sheet1.UsedRange.Rows.Count) Sz = 0 'Ciklussal végigmegyünk minden cellán For Each MyCell In MyRange.Cells txtPartnerNeve = MyCell.Value txtPartnerAdoszama = MyCell.Offset(0, 1).Value txtPartnerSzekhelye = MyCell.Offset(0, 2).Value txtPartnerMegszolitas = MyCell.Offset(0, 3).Value txtKeltezes = MyCell.Offset(0, 4).Value txtAlairasiKep = MyCell.Offset(0, 5).Value txtAlairasiNev = MyCell.Offset(0, 6).Value If Len(Replace(Time, ":", "")) = 5 Then Ido = 0 & Replace(Time, ":", "") Else Ido = Replace(Time, ":", "") 'e.g. 9-> 09 WordNewFileName = Application.WorksheetFunction.Substitute(txtPartnerNeve, ".", "") & "-" & _ Application.WorksheetFunction.Substitute(txtAlairasiNev, ".", "") & "_" & Replace(Date, ".", "") & "_" & Ido If txtPartnerNeve = "" Or txtPartnerAdoszama = "" Or txtPartnerSzekhelye = "" Or txtPartnerMegszolitas = "" Or _ txtKeltezes = "" Or txtAlairasiKep = "" Or txtAlairasiNev = "" Then GoTo Kovetkezo Sz = Sz + 1 'Word: új példány indítása és új dokumentum létrehozása Set Wd = New Word.Application 'Set wdDoc = wd.Documents.Add Wd.Visible = True 'a sablon megnyitása Set WdDoc = Wd.Documents.Open(WordTemplFileName) '---------------------------------------------------- 'dokumentum egy oldalon legyen WdDoc.PageSetup.PageWidth = Wd.InchesToPoints(8.27) 'A4 format WdDoc.PageSetup.PageHeight = Wd.InchesToPoints(11.69) 'A4 format '------------------------------------------------------------------- 'releváns könyvjelzők kitöltése a megfelelő értékekkel Wd.Selection.Goto What:=wdGoToBookmark, Name:="PartnerNeve" Wd.Selection.TypeText Text:=txtPartnerNeve Wd.Selection.Goto What:=wdGoToBookmark, Name:="PartnerAdoszama" Wd.Selection.TypeText Text:=txtPartnerAdoszama Wd.Selection.Goto What:=wdGoToBookmark, Name:="PartnerSzekhelye" Wd.Selection.TypeText Text:=txtPartnerSzekhelye Wd.Selection.Goto What:=wdGoToBookmark, Name:="PartnerMegszolitas" Wd.Selection.TypeText Text:=txtPartnerMegszolitas Wd.Selection.Goto What:=wdGoToBookmark, Name:="Keltezes" Wd.Selection.TypeText Text:=txtKeltezes 'Wd.Selection.Goto What:=wdGoToBookmark, Name:="AlairasiKep" 'Wd.Selection.TypeText Text:=txtAlairasiKep WdDoc.Bookmarks("AlairasiKep").Range.InlineShapes.AddPicture (txtAlairasiKep) Wd.Selection.Goto What:=wdGoToBookmark, Name:="AlairasiNev" Wd.Selection.TypeText Text:=txtAlairasiNev 'megmaradt könyvjelzők törlése On Error Resume Next WdDoc.Bookmarks("PartnerNeve").Delete WdDoc.Bookmarks("PartnerAdoszama").Delete WdDoc.Bookmarks("PartnerSzekhelye").Delete WdDoc.Bookmarks("PartnerMegszolitas").Delete WdDoc.Bookmarks("Keltezes").Delete WdDoc.Bookmarks("AlairasiKep").Delete WdDoc.Bookmarks("AlairasiNev").Delete On Error GoTo 0 'Word-ben: adott oldal mentése word és pdf fájlba a makrót tartalmazó Excel fájl mappájában: WdDoc.SaveAs FileName:=ThisWorkbook.Path & "\" & WordNewFileName 'a sablon Word formátumában ment (pl.: .docx) WdDoc.ExportAsFixedFormat ThisWorkbook.Path & "\" & WordNewFileName & ".pdf", exportformat:=wdExportFormatPDF WdDoc.Close True 'ez már az újonnan létrehozott Word fájlok egyike, ezért jó a "True" Wd.Quit Set WdDoc = Nothing Kovetkezo: Next MyCell Set Wd = Nothing MsgBox "A makró lefutott és " & Sz & " dokumentumot hozott létre Word és PDF formátumban " & _ "a makrót tartalmazó Excel fájl mappájában:" & vbNewLine & vbNewLine & _ ThisWorkbook.Path & "\", vbInformation, "" Vege: End Sub |
Ha kérdésed, észrevételed van, lépj velem kapcsolatba.
Üdv.,
XLMotyo
