Office 2010 - VBA/makro v excelu na tisk souboru word

[signal]

Dobrý den,
Rád bych se obrátil na místní odborníky o pomoc. Ve své práci potřebuji vytisknout smlouvy pro své zákazníky. Vždy se jedná o několik dokumentů (5) ve wordu, ve kterých se vypisují nacionále klienta a také další 4 dokumenty, kde sice není nutné vypisovat nacionále, ale je potřeba vyplnit datum a místo. Abych nemusel vždy každou část smluv vyplňovat zvlášť, udělal jsem si jednotnou tabulku v excelu a propojil s jednotlivými dokumenty ve wordu. Tím jsem docílil toho, že se mi všechny údaje nakopírují do každého propojeného souboru. Tuto tabulku v excelu jsem chtěl vylepšit tím, že jsem po straně vytvořil několik tlačítek (pro každý dokument jedno). Ke každému tlačítku jsem chtěl vytvořit VBA/makro, které by dělalo to, že se konkrétní dokument vytiskne v požadovaném počtu kopií (tento počet je u každého dokumentu jiný, proto co dokument to tlačítko). Předpokládám, že prakticky by to makro mělo otevřít dokument, akceptovat změny,vytisknout v požadovaném počtu kopií a dokument bez uložení opět zavřít. A tady jsem narazil. Nejsem schopen toto makro sestavit. Docílím vždy jen toho, že se mi dokument otevře. A tím to končí. Mám Office 2010. Budu vděčný za jakoukoliv pomoc a návrh, jak by toto makro mělo vypadat. Pokud by byl i jiný, lepší postup pro vyplňování dokumentů (než formou propojení), nebráním se jakýmkoliv změnám. Předem děkuji.

[Reklama]

[signal]

Nikdo neporadí? Není problém popsán dostatečně, nebo srozumitelně?

[Azuzula]

Zdravím Tě,
vyzkoušej tohle:
Makro vlož do modulu maker v excelu:

Kód: Vybrat vše

Sub tisk_doc()
Dim wordApp As Object
Dim strFile As String, tmp as string
Dim kopie As Integer
Dim konec As Boolean

'**********************************************
'cesta k dokumentu
strFile = ThisWorkbook.Path & "\dopis.docm"
'počet kopií k tisku
kopie = 1
'**********************************************

On Error Resume Next
Set wordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set wordApp = CreateObject("Word.Application")
    konec = True
End If
Err.Clear
On Error GoTo 0
                       
wordApp.Visible = True
wordApp.Documents.Open (strFile) 'otevře soubor k tisku
On Error Resume Next

tmp = wordApp.ActivePrinter
wordApp.ActivePrinter = "Duplex" 'přepne na tiskárnu s oboustraným tiskem
wordApp.PrintOut Copies:=kopie 'tiskne
wordApp.ActivePrinter = tmp 'přepne zpět na výchozí tiskárnu
On Error GoTo 0

If konec = True Then
    wordApp.activedocument.Close False 'zavře dokument bez uložení
    wordApp.Quit 'ukončí word
Else
    wordApp.activedocument.Close False 'zavře dokument bez uložení, word nechá spuštěný
End If
End Sub

Ve Wordu nedělám už léta a tak ani nevím jak fungují ta propojení která tam máš. Snad to bude chodit s tímhle makrem.

[signal]

Ahoj,

díky moc za pomoc. Bohužel tohle makro nefunguje. Nastavil jsem v něm cestu k tomu dokumentu, ale když ho chci použít, tak to hodí Run-time error'4248': Tento příkaz není k dispozici, protože není otevřen žádný dokument.

Přiložil jsem celý soubor, kdyby si se na to chtěla podívat.
Já právě taky ve Wordu moc makrům nerozumím. V Excelu to pro mě není zas takový problém, ale Word nedávám. Bohužel ty smlouvy jsou ve Wordu.

[Azuzula]

Jedinou chybu máš v tom řádku nastavení cesty k dokumentu.
ThisWorkbook.Path je proměnná ve které je cesta k souboru sešitu, proto je za tím v mém makru jen lomítku a název dokumentu.

Když budeš mít všechny soubory v jedné složce tak jak jsi je dal do toho raru, tak stačí jen změnit název dokumentu který chceš tisknout.
strFile = ThisWorkbook.Path & "\01 - Smlouva.docx"
Případně strFile = ThisWorkbook.Path & "\podsložka\01 - Smlouva.docx" když budeš mít všechny dokumenty v podsložce.

Pokud i přes to chceš pevně danou cestu, tak napíšeš strFile = "c:\SMLOUVY-KLIENT\01 - Smlouva.docx"

[signal]

Jo, tak teď to funguje. Díky.

Já mezitím sestavil tohle makro, které taky funguje, ale řekl bych, že to tvoje je daleko lepší.

Kód: Vybrat vše

Sub PROTOKOL_Tisk2()

  Dim objWord

  Dim objDoc

  Set objWord = CreateObject("Word.Application")

  Set objDoc = objWord.Documents.Open("c:\SMLOUVY-KLIENT\01 - Smlouva.docx")

  objWord.Visible = False

  objDoc.PrintOut , Copies:=3
 
  objDoc.Close

  objWord.Quit

End Sub

Teď akorát řeším dva problémy.
1) jak v makru nastavit, aby se tisklo oboustranně. Jde to vůbec? Co jsem hledal na internetu, tak je to asi docela problém. Ale všechno to byly diskuze o verzích 2003 a 2007. Tak nevím jestli v 2010 už to náhodou nejde.

2) makro které by udělalo "Uložení do PDF" tzn. po kliknutí na toto tlačítko se ve složce "c:\KLIENTI" vytvoří podsložka s klientovým jménem (které je v buňce D6) a do ní se uloží dokumenty v .pdf tzn. "jmeno prijmeni (z D6) - smlouva" ; "jmeno prijmeni - protokol" ; "jmeno prijmeni - dotaznik" ; "jmeno prijmeni - cenik" atd.

Kdyby si mi pomohla ještě s tímhle, tak bych ti byl velmi vděčný.

[Azuzula]

Tak jsem prohledala internet a našla několik možností. Nejlepší se mi zdá být přidání nové tiskárny v ovládacích panelech a nastavit jí výchozí oboustraný tisk. Pojmenuj ji například Duplex a pak stačí přidat pár řádků do makra.
Upraveno původní makro.

Do PDF chceš ukládat nějakou oblast buněk z excelu, nebo ty tištěné dokumenty z Wordu?

[signal]

Díky moc.

Tak jsem přidal novou tiskárnu a jdu vyzkoušet to nový makro.

Co se týká toho PDF, tak chci ukládat ty dokumenty z Wordu. Když kliknu na to tlačítko vpravo dole, tak aby se všechny dokumenty uložily do nově vytvořené složky. Tzn. vyplním tabulku na jméno "NOVÁK Jan" (příjmení a jméno je v buňce D6) a pokud to nebudu chtít rovnou tisknout, tak kliknu na tlačítko "Uložit do PDF" a moje představa je, že v tu chvíli se ve složce "c:\KLIENTI" vytvoří nová podsložka "NOVÁK Jan" a do ní se každý z těch dokumentů uloží v PDF s názvem "NOVÁK Jan - smlouva" ; "NOVÁK Jan - protokol" ; "NOVÁK Jan - dotaznik" ; "NOVÁK Jan - cenik" atd.
Makro by tedy mělo umět vytvořit podsložku (s názvem z určité buňky) ve složce, otevřít každý dokument (Word), akceptovat změny, uložit ho v PDF v té podsložce s názvem, který se skládá z názvu z buňky a názvu dokumentu. Následně dokument zase bez uložení zavřít. A tohle zopakovat u všech 6 dokumentů.

Tak teď jsem to celé vyzkoušel a funguje to perfektně. Ten nápad s tou další tiskárnou je fakt skvělý.

[Azuzula]

Taky mi to přišlo lepší, jinak jsem našla soustavu několika maker a funkcí které duplex řeší programově přímo v excelu. Jo, je to pak bez práce když se to náhodou podaří rozchodit. Mě to nešlo, ale to možná bude tím, že nemám tiskárnu.

Tady je makro na uložení všech dokumentů do PDF.

Kód: Vybrat vše

Sub ulozPDF()
Dim fso
Dim wordApp As Object
Dim jmeno As String, sFile0(5) As String, sFile1(5) As String, sPath0 as String, sPtah1 as String
Dim a As Integer, x As Integer
Dim konec As Boolean
'**********************************************
'soubory k uložení do PDF
sFile0(0) = "Smlouva"
sFile1(0) = "01 - Smlouva.docx"
sFile0(1) = "Protokol"
sFile1(1) = "02 - Protokol.docx"
sFile0(2) = "Dotaznik"
sFile1(2) = "03 - Dotaznik.docx"
sFile0(3) = "Cenik"
sFile1(3) = "04 - Cenik.docx"
sFile0(4) = "Souhlas s kopii"
sFile1(4) = "05 - Souhlas s kopii.docx"
sFile0(5) = "VOP"
sFile1(5) = "06 - VOP.docx"
sPath0 = "c:\klienti\" 'složka klientů
sPath1 = "c:\smlouvy\" 'složka smluv
'**********************************************

jmeno = Range("D8") 'jméno klienta
'zkontroluje/vytvoří podsložku klienta
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.folderexists(sPath0 & jmeno) = False Then
    MkDir (sPath0 & jmeno)
End If

'kontrola spuštění wordu
On Error Resume Next
Set wordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set wordApp = CreateObject("Word.Application")
    konec = True
End If
Err.Clear
On Error GoTo 0

'zpracuje výstup
wordApp.Visible = True
For a = 0 To 5
    wordApp.Documents.Open (sPath1 & sFile1(a)) 'otevře soubor
    wordApp.ActiveDocument.SaveAs2 sPath0 & jmeno & "\" & jmeno & " - " & sFile0(a) & ".pdf", 17 'uloží doubor do PDF
    wordApp.ActiveDocument.Close False 'zavře soubor
Next

If konec = True Then
    wordApp.Quit 'ukončí word
End If
End Sub


[signal]

Tak u tohoto makra mi to hází 76 : Path not found
a ukazuje na řádek MkDir (ThisWorkbook.Path & "\klienti\" & jmeno)

Zkusil jsem i nastavit pevnou cestu c:\klienti\ ale taky to nefunguje. Mám tam něco jinak nastavit?

[Azuzula]

Máš složku "klienti" ve stejný složce jako je ten sešit excelu? Jestli ano, tak nevím v čem je chyba. Mohlo by taky záležet na velikosti písmen, čert aby se vyznal ve všech verzích a jazykových mutacích excelu...

[signal]

Ne, složka "klienti" je na "c:\KLIENTI\" stejně jako "c:\SMLOUVY\" . Obě složky jsou "vedle sebe" v kořenovém adresáři. Proto jsem tam taky zkusil dát pevnou cestu, ale nešlo to.