Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Sending from excel to word template
PLEASE HELP ME i have macro like this below which includes records from excel to word template, but I'd like to convert it in such way, that it includes records from excel to one word document (It is preparing one word document now for every record from excel). It should works like that: excel opens word template and inludes every record from excel to bookmarks in word template and then it saves document. Are You able to convert this macro below? Best regards Thomas Sub Auto_open() Range("Bad name of file") = ThisWorkbook.path & "\" & "szablon.doc" End Sub Private Sub ExtractFilePathNameExt(Plik, path, name, ext) For i = Len(Plik) To 1 Step -1 Select Case Mid(Plik, i, 1) Case "." ext = Mid(Plik, i + 1) extPos = i Case "\" If path = "" Then path = Mid(Plik, 1, i - 1) name = Mid(Plik, i + 1, extPos - i - 1) Exit For End Select Next i End Sub Private Sub MS_Word(Plik, r As Range, Optional path) Dim wd As Object If IsMissing(path) Then path = "" 'Utworzenie sesji Microsoft Word On Error Resume Next Set wd = GetObject(, "word.application") If Err.Number < 0 Then Err.Clear Set wd = CreateObject("word.application") End If On Error GoTo 0 ExtractFilePathNameExt Plik, path, name, ext nr = 0 wd.Documents.Open Plik Set rw = r.Range("a2", Cells(r.Rows.Count, r.Columns.Count)) k = 0 For Each i In rw.Rows For j = 0 To rw.Columns.Count - 1 TypeToWord wd, r.Offset(0, j).Cells(1), rw.Offset(k, j).Cells(1) Next j wd.activedocument.SaveAs path & "\karty\" & name & " " & nr & "." & ext k = k + 1 nr = nr + 1 Next i wd.Quit Set wd = Nothing End Sub Private Sub TypeToWord(wd, name, text) On Error Resume Next wd.activedocument.GoTo(name:=name).Select If Err.Number = 0 Then wd.Selection.text = text On Error GoTo 0 With wd.activedocument.Bookmarks .Add Range:=wd.Selection.Range, name:=name .DefaultSorting = wdSortByName .ShowHidden = False End With Else Err.Clear End If End Sub Sub Makro1() If Dir(Range("Nazwa_Pliku_tekstowego").text) = "" Then MsgBox "Wrong name of text file" Range("Nazwa_Pliku_tekstowego").Select Exit Sub End If MS_Word Range("Nazwa_Pliku_tekstowego").text, Range("TabelaDanych") End Sub -- pizdus ------------------------------------------------------------------------ pizdus's Profile: http://www.excelforum.com/member.php...o&userid=30565 View this thread: http://www.excelforum.com/showthread...hreadid=502142 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Reflecting info between an excel file and a word one or two excel file. | Links and Linking in Excel | |||
Windows in TaskBar in Excel doesn't Work the Same as in Word | Excel Discussion (Misc queries) | |||
Excel startup switches | Excel Discussion (Misc queries) | |||
exporting excel worksheet to word | Links and Linking in Excel | |||
Merging data from an excel worksheet into an excel template | Excel Worksheet Functions |