Generowanie dokumentów Word (w Excelu VBA) z serii szablonów dokumentów
Cześć wszystkim. Postaram się, żeby to było krótkie i proste. :)
Mam
- 40 lub tak kotła dokumentów programu word z serii pól (Nazwa, adres, itp), które muszą być wypełnione. Jest to historycznie wykonywane ręcznie, ale jest to powtarzalne i uciążliwe.
- skoroszyt, w którym użytkownik wypełnił ogromny zestaw informacji o jednostce.
I need
- sposób na programowe (z Excela VBA) otwieranie tych kotłów dokumenty, Edytuj wartość pól z różnych nazwanych zakresów w skoroszycie i zapisz wypełnione szablony do folderu lokalnego.
Gdybym używał VBA do programowej edycji poszczególnych wartości w zestawie arkuszy kalkulacyjnych, edytowałbym wszystkie te arkusze kalkulacyjne, aby zawierały zestaw nazwanych zakresów, które mogłyby być używane podczas procesu automatycznego wypełniania, ale nie jestem świadomy żadnej funkcji "nazwanego pola" w dokumencie programu Word.
Jak mogę edytować dokumenty i utworzyć procedurę VBA, więc że mogę otworzyć każdy dokument, wyszukać zestaw pól, które mogą wymagać wypełnienia i zastąpić wartość?
Na przykład coś, co działa jak:
for each document in set_of_templates
if document.FieldExists("Name") then document.Field("Name").value = strName
if document.FieldExists("Address") then document.Field("Name").value = strAddress
...
document.saveAs( thisWorkbook.Path & "\GeneratedDocs\ " & document.Name )
next document
Rzeczy, które rozważałem:
- Mail merge-ale jest to niewystarczające, ponieważ wymaga ręcznego otwierania każdego dokumentu i strukturyzowania skoroszytu jako źródła danych, chcę czegoś odwrotnego. Szablony są źródłem danych, a skoroszyt jest przez nie powtarzany. Również Mail merge jest dla tworzenie wielu identycznych dokumentów przy użyciu tabeli różnych danych. Mam wiele dokumentów wykorzystujących te same dane.
- używanie tekstu zastępczego, takiego jak "# nazwa# " i otwieranie każdego dokumentu w celu wyszukania i zastąpienia. To jest rozwiązanie, do którego uciekłbym się, gdyby nie zaproponowano nic bardziej eleganckiego.
4 answers
Minęło sporo czasu odkąd zadałem to pytanie, a moje rozwiązanie ulegało coraz bardziej wyrafinowaniu. Miałem do czynienia z różnego rodzaju szczególnymi przypadkami, takimi jak wartości, które pochodzą bezpośrednio ze skoroszytu, sekcje, które muszą być specjalnie generowane na podstawie list, oraz konieczność wymiany nagłówków i stopek.
Jak się okazuje, nie wystarczyło użycie zakładek, ponieważ użytkownicy mogli później edytować dokumenty w celu zmiany, dodania i usunięcia elementów zastępczych wartości z dokumentów. Rozwiązanie polegało na użyciu słów kluczowych takich jak:
Jest to tylko strona z przykładowego dokumentu, która wykorzystuje niektóre z możliwych wartości, które mogą zostać automatycznie wstawione do dokumentu. Istnieje ponad 50 dokumentów o zupełnie różnych strukturach i układach oraz o różnych parametrach. Jedyną wspólną wiedzą dzieloną przez dokumenty word i arkusz kalkulacyjny excel jest wiedza o tym, co te wartości zastępcze mają reprezentować. W programie excel jest to przechowywane na liście słów kluczowych generujących dokument, które zawierają słowo kluczowe, a następnie odniesienie do zakresu, który faktycznie zawiera tę wartość: {]}
To były kluczowe dwa składniki wymagane. Teraz z jakimś sprytnym kodem, wszystko, co musiałem zrobić, to iterację nad każdym dokumentem do wygenerowania, a następnie iterację nad zakresem wszystkich znanych słów kluczowych, i zrobić wyszukiwanie i zastąpić dla każdego słowa kluczowego w każdym dokument.
Po pierwsze, mam metodę wrapper, która dba o utrzymanie instancji programu microsoft word iterację nad wszystkimi dokumentami wybranymi do generowania, numeracji dokumentów, i robi rzeczy interfejsu użytkownika (jak obsługa błędów, wyświetlanie folderu do użytkownika, itp.)
' Purpose: Iterates over and generates all documents in the list of forms to generate
' Improves speed by creating a persistant Word application used for all generated documents
Public Sub GeneratePolicy()
Dim oWrd As New Word.Application
Dim srcPath As String
Dim cel As Range
If ERROR_HANDLING Then On Error GoTo errmsg
If Forms.Cells(2, FormsToGenerateCol) = vbNullString Then _
Err.Raise 1, , "There are no forms selected for document generation."
'Get the path of the document repository where the forms will be found.
srcPath = FindConstant("Document Repository")
'Each form generated will be numbered sequentially by calling a static counter function. This resets it.
GetNextEndorsementNumber reset:=True
'Iterate over each form, calling a function to replace the keywords and save a copy to the output folder
For Each cel In Forms.Range(Forms.Cells(2, FormsToGenerateCol), Forms.Cells(1, FormsToGenerateCol).End(xlDown))
RunReplacements cel.value, CreateDocGenPath(cel.Offset(0, 1).value), oWrd
Next cel
oWrd.Quit
On Error Resume Next
'Display the folder containing the generated documents
Call Shell("explorer.exe " & CreateDocGenPath, vbNormalFocus)
oWrd.Quit False
Application.StatusBar = False
If MsgBox("Policy generation complete. The reserving information will now be recorded.", vbOKCancel, _
"Policy Generated. OK to store reserving info?") = vbOK Then Push_Reserving_Requirements
Exit Sub
errmsg:
MsgBox Err.Description, , "Error generating Policy Documents"
End Sub
Ta procedura wywołuje RunReplacements
, która zajmuje się otwieraniem dokumentu, przygotowaniem środowiska do szybkiej wymiany, aktualizacją linków po wykonaniu, obsługą błędów, itd:
' Purpose: Opens up a document and replaces all instances of special keywords with their respective values.
' Creates an instance of Word if an existing one is not passed as a parameter.
' Saves a document to the target path once the template has been filled in.
'
' Replacements are done using two helper functions, one for doing simple keyword replacements,
' and one for the more complex replacements like conditional statements and schedules.
Private Sub RunReplacements(ByVal DocumentPath As String, ByVal SaveAsPath As String, _
Optional ByRef oWrd As Word.Application = Nothing)
Dim oDoc As Word.Document
Dim oWrdGiven As Boolean
If oWrd Is Nothing Then Set oWrd = New Word.Application Else oWrdGiven = True
If ERROR_HANDLING Then On Error GoTo docGenError
oWrd.Visible = False
oWrd.DisplayAlerts = wdAlertsNone
Application.StatusBar = "Opening " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1)
Set oDoc = oWrd.Documents.Open(Filename:=DocumentPath, Visible:=False)
RunAdvancedReplacements oDoc
RunSimpleReplacements oDoc
UpdateLinks oDoc 'Routine which will update calculated statements in Word (like current date)
Application.StatusBar = "Saving " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1)
oDoc.SaveAs SaveAsPath
GoTo Finally
docGenError:
MsgBox "Un unknown error occurred while generating document: " & DocumentPath & vbNewLine _
& vbNewLine & Err.Description, vbCritical, "Document Generation"
Finally:
If Not oDoc Is Nothing Then oDoc.Close False: Set oDoc = Nothing
If Not oWrdGiven Then oWrd.Quit False
End Sub
Ta rutyna wywołuje RunSimpleReplacements
. i RunAdvancedReplacements
. W tym pierwszym, iterujemy nad zestawem słów kluczowych generujących dokument i wywołujemy WordDocReplace
, jeśli dokument zawiera nasze słowo kluczowe. Zauważ, że znacznie szybciej jest spróbować i Find
kilka słów, aby dowiedzieć się, że nie istnieją, a następnie wywołać replace bezkrytycznie, więc zawsze sprawdzamy, czy słowo kluczowe istnieje przed próbą zastąpienia go.
' Purpose: While short, this short module does most of the work with the help of the generation keywords
' range on the lists sheet. It loops through every simple keyword that might appear in a document
' and calls a function to have it replaced with the corresponding data from pricing.
Private Sub RunSimpleReplacements(ByRef oDoc As Word.Document)
Dim DocGenKeys As Range, valueSrc As Range
Dim value As String
Dim i As Integer
Set DocGenKeys = Lists.Range("DocumentGenerationKeywords")
For i = 1 To DocGenKeys.Rows.Count
If WordDocContains(oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#") Then
'Find the text that we will be replacing the placeholder keyword with
Set valueSrc = Range(Mid(DocGenKeys.Cells(i, 2).Formula, 2))
If valueSrc.MergeCells Then value = valueSrc.MergeArea.Cells(1, 1).Text Else value = valueSrc.Text
'Perform the replacement
WordDocReplace oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#", value
End If
Next i
End Sub
Jest to funkcja używana do wykrywania, czy słowo kluczowe istnieje w dokument:
' Purpose: Function called for each replacement to first determine as quickly as possible whether
' the document contains the keyword, and thus whether replacement actions must be taken.
Public Function WordDocContains(ByRef oDoc As Word.Document, ByVal searchFor As String) As Boolean
Application.StatusBar = "Checking for keyword: " & searchFor
WordDocContains = False
Dim storyRange As Word.Range
For Each storyRange In oDoc.StoryRanges
With storyRange.Find
.Text = searchFor
WordDocContains = WordDocContains Or .Execute
End With
If WordDocContains Then Exit For
Next
End Function
I tu guma styka się z drogą-kod, który wykonuje wymianę. Ta rutyna stała się bardziej skomplikowana, gdy napotykałem trudności. Oto lekcje, których nauczysz się tylko z doświadczenia: {]}
Możesz ustawić tekst zastępczy bezpośrednio lub użyć schowka. Przekonałem się na własnej skórze, że jeśli wykonujesz zastąpienie VBA w Wordzie za pomocą ciągu dłuższego niż 255 znaków, tekst zostanie obcięty, jeśli spróbujesz umieścić jest w
Find.Replacement.Text
, ale możesz użyć"^c"
jako zastępczego tekstu, a otrzyma go bezpośrednio ze schowka. To było obejście, którego musiałem użyć.Po prostu wywołanie replace spowoduje pominięcie słów kluczowych w niektórych obszarach tekstowych, takich jak nagłówki i stopki. Z tego powodu, w rzeczywistości trzeba iterację nad
document.StoryRanges
i uruchomić wyszukiwanie i zastąpić na każdym z nich, aby upewnić się, że można złapać wszystkie instancje słowa, które chcesz zastąpić.Jeśli ustawiasz
Replacement.Text
bezpośrednio musisz przekonwertować podziały linii programu Excel (vbNewLine
iChr(10)
) za pomocą prostegovbCr
, aby poprawnie wyświetlały się w programie word. W przeciwnym razie wszędzie, gdzie tekst zastępczy ma podziały linii pochodzące z komórki programu excel, zostanie wstawiony dziwne symbole do programu word. Jeśli jednak używasz metody schowka, nie musisz tego robić, ponieważ po umieszczeniu w schowku przerwy linii są automatycznie konwertowane.
' Purpose: This function actually performs replacements using the Microsoft Word API
Public Sub WordDocReplace(ByRef oDoc As Word.Document, ByVal replaceMe As String, ByVal replaceWith As String)
Dim clipBoard As New MSForms.DataObject
Dim storyRange As Word.Range
Dim tooLong As Boolean
Application.StatusBar = "Replacing instances of keyword: " & replaceMe
'We want to use regular search and replace if we can. It's faster and preserves the formatting that
'the keyword being replaced held (like bold). If the string is longer than 255 chars though, the
'standard replace method doesn't work, and so we must use the clipboard method (^c special character),
'which does not preserve formatting. This is alright for schedules though, which are always plain text.
If Len(replaceWith) > 255 Then tooLong = True
If tooLong Then
clipBoard.SetText IIf(replaceWith = vbNullString, "", replaceWith)
clipBoard.PutInClipboard
Else
'Convert excel in-cell line breaks to word line breaks. (Not necessary if using clipboard)
replaceWith = Replace(replaceWith, vbNewLine, vbCr)
replaceWith = Replace(replaceWith, Chr(10), vbCr)
End If
'Replacement must be done on multiple 'StoryRanges'. Unfortunately, simply calling replace will miss
'keywords in some text areas like headers and footers.
For Each storyRange In oDoc.StoryRanges
Do
With storyRange.Find
.MatchWildcards = True
.Text = replaceMe
.Replacement.Text = IIf(tooLong, "^c", replaceWith)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
On Error Resume Next
Set storyRange = storyRange.NextStoryRange
On Error GoTo 0
Loop While Not storyRange Is Nothing
Next
If tooLong Then clipBoard.SetText ""
If tooLong Then clipBoard.PutInClipboard
End Sub
Gdy opadnie kurz, zostaje nam piękna wersja dokumentu początkowego z wartościami produkcyjnymi zamiast tych słów kluczowych oznaczonych skrótem. Chciałbym pokazać przykład, ale oczywiście każdy wypełniony dokument zawiera wszystkie zastrzeżone informacje.
/ Align = "left" / Robi coś bardzo podobnego - kończy się wywołaniem tej samej funkcji
WordDocReplace
, ale co specjalne o słowa kluczowe używane tutaj jest to, że nie łączą się one z pojedynczą komórką w oryginalnym skoroszycie, są generowane w kodzie z list w skoroszycie. Tak na przykład, jeden z zaawansowanych zamienników wyglądałby tak: {]}
'Generate the schedule of vessels
If WordDocContains(oDoc, "#VESSELSCHEDULE#") Then _
WordDocReplace oDoc, "#VESSELSCHEDULE#", GenerateVesselSchedule()
W tym celu należy utworzyć ciąg znaków zawierający wszystkie informacje o statku skonfigurowane przez użytkownika:
' Purpose: Generates the list of vessels from the "Vessels" sheet based on the user's configuration
' in the booking tab. The user has the option to generate one or both of Owned Vessels
' and Chartered Vessels, as well as what fields to display. Uses a helper function.
Public Function GenerateVesselSchedule() As String
Dim value As String
Application.StatusBar = "Generating Schedule of Vessels."
If Booking.Range("ListVessels").value = "Yes" Then
Dim VesselCount As Long
If Booking.Range("ListVessels").Offset(1).value = "Yes" Then _
value = value & GenerateVesselScheduleHelper("Vessels", VesselCount)
If Booking.Range("ListVessels").Offset(1).value = "Yes" And _
Booking.Range("ListVessels").Offset(2).value = "Yes" Then _
value = value & "(Chartered Vessels)" & vbNewLine
If Booking.Range("ListVessels").Offset(2).value = "Yes" Then _
value = value & GenerateVesselScheduleHelper("CharteredVessels", VesselCount)
If Len(value) > 2 Then value = Left(value, Len(value) - 2) 'Remove the trailing line break
Else
GenerateVesselSchedule = Booking.Range("VesselSchedAlternateText").Text
End If
GenerateVesselSchedule = value
End Function
' Purpose: Helper function for the Vessel Schedule generation routine. Generates either the Owned or
' Chartered vessels based on the schedule parameter passed. The list is numbered and contains
' the information selected by the user on the Booking sheet.
' SENSITIVE: Note that this routine is sensitive to the layout of the Vessel Schedule tab and the
' parameters on the Configure Quotes tab. If either changes, it should be revisited.
Public Function GenerateVesselScheduleHelper(ByVal schedule As String, ByRef VesselCount As Long) As String
Dim value As String, nextline As String
Dim numInfo As Long, iRow As Long, iCol As Long
Dim Inclusions() As Boolean, Columns() As Long
'Gather info about vessel info to display in the schedule
With Booking.Range("VesselInfoToInclude")
numInfo = Booking.Range(.Cells(1, 1), .End(xlToRight)).Columns.Count - 1
ReDim Inclusions(1 To numInfo)
ReDim Columns(1 To numInfo)
On Error Resume Next 'Some columns won't be identified
For iCol = 1 To numInfo
Inclusions(iCol) = .Offset(0, iCol) = "Yes"
Columns(iCol) = sumSchedVessels.Range(schedule).Cells(1).EntireRow.Find(.Offset(-1, iCol)).Column
Next iCol
On Error GoTo 0
End With
'Build the schedule
With sumSchedVessels.Range(schedule)
For iRow = .row + 1 To .row + .Rows.Count - 1
If Len(sumSchedVessels.Cells(iRow, Columns(1)).value) > 0 Then
VesselCount = VesselCount + 1
value = value & VesselCount & "." & vbTab
nextline = vbNullString
'Add each property that was included to the description string
If Inclusions(1) Then nextline = nextline & sumSchedVessels.Cells(iRow, Columns(1)) & vbTab
If Inclusions(2) Then nextline = nextline & "Built: " & sumSchedVessels.Cells(iRow, Columns(2)) & vbTab
If Inclusions(3) Then nextline = nextline & "Length: " & _
Format(sumSchedVessels.Cells(iRow, Columns(3)), "#'") & vbTab
If Inclusions(4) Then nextline = nextline & "" & sumSchedVessels.Cells(iRow, Columns(4)) & vbTab
If Inclusions(5) Then nextline = nextline & "Hull Value: " & _
Format(sumSchedVessels.Cells(iRow, Columns(5)), "$#,##0") & vbTab
If Inclusions(6) Then nextline = nextline & "IV: " & _
Format(sumSchedVessels.Cells(iRow, Columns(6)), "$#,##0") & vbTab
If Inclusions(7) Then nextline = nextline & "TIV: " & _
Format(sumSchedVessels.Cells(iRow, Columns(7)), "$#,##0") & vbTab
If Inclusions(8) And schedule = "CharteredVessels" Then _
nextline = nextline & "Deductible: " & Format(bmCharterers.Range(schedule).Cells( _
iRow - .row, 9), "$#,##0") & vbTab
nextline = Left(nextline, Len(nextline) - 1) 'Remove the trailing tab
'If more than 4 properties were included insert a new line after the 4th one
Dim tabloc As Long: tabloc = 0
Dim counter As Long: counter = 0
Do
tabloc = tabloc + 1
tabloc = InStr(tabloc, nextline, vbTab)
If tabloc > 0 Then counter = counter + 1
Loop While tabloc > 0 And counter < 4
If counter = 4 Then nextline = Left(nextline, tabloc - 1) & vbNewLine & Mid(nextline, tabloc)
value = value & nextline & vbNewLine
End If
Next iRow
End With
GenerateVesselScheduleHelper = value
End Function
Wynikowy ciąg może być używany tak jak zawartość dowolnej komórki excel, i przekazywane do funkcji zastępczej, która odpowiednio użyje metody schowka, jeśli przekroczy 255 znaków.
Więc ten szablon:
Dodatkowo dane arkusza kalkulacyjnego:
Staje się tym dokumentem:
Mam szczerą nadzieję, że to kiedyś komuś pomoże. To było zdecydowanie ogromne przedsięwzięcie i skomplikowane koło, które trzeba było wymyślić na nowo. Aplikacja jest Ogromny, z ponad 50 000 linii kodu VBA, więc jeśli odwołałem się do kluczowej metody w moim kodzie gdzieś, że ktoś potrzebuje, proszę zostawić komentarz, a ja go dodać tutaj.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2014-07-08 20:39:25
Http://www.computorcompanion.com/LPMArticle.asp?ID=224 opisuje użycie słowa zakładki
Fragment tekstu w dokumencie może być oznaczony zakładką i otrzymać nazwę zmiennej. Za pomocą VBA można uzyskać dostęp do tej zmiennej, a zawartość dokumentu można zastąpić alternatywną zawartością. Jest to rozwiązanie pozwalające na umieszczenie w dokumencie elementów zastępczych, takich jak nazwa i adres.
Ponadto, za pomocą zakładek, dokumenty mogą być modyfikowane do odwołania tekst z zakładkami. Jeśli nazwa pojawia się kilka razy w dokumencie, pierwsza instancja może zostać dodana do zakładek, a dodatkowe wystąpienia mogą odwoływać się do zakładki. Teraz, gdy pierwsza instancja jest programowo zmieniana, wszystkie inne instancje zmiennej w całym dokumencie są również automatycznie zmieniane.
Teraz wystarczy zaktualizować wszystkie dokumenty, zaznaczając tekst zastępczy i stosując spójną konwencję nazewnictwa w dokumentach, a następnie powtarzając każdy dokument zastępuje zakładkę, jeśli istnieje:
document.Bookmarks("myBookmark").Range.Text = "Inserted Text"
Prawdopodobnie mogę rozwiązać problem zmiennych, które nie pojawiają się w danym dokumencie, używając klauzuli On error resume next przed przystąpieniem do każdej wymiany.
Podziękowania dla Douga Glancy ' ego za wzmiankę o istnieniu zakładek w komentarzu. Wcześniej nie wiedziałem o ich istnieniu. Będę na bieżąco informował o tym, czy takie rozwiązanie wystarczy.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2017-05-23 12:26:12
Można rozważyć podejście oparte na XML.
Word posiada funkcję o nazwie Custom XML data-binding lub data-bound content controls. Kontrola zawartości jest zasadniczo punktem w dokumencie, który może zawierać zawartość. Kontrolka zawartości "związanej z danymi" pobiera swoją zawartość z dokumentu XML dołączonego do pliku ZIP docx. Wyrażenie XPath jest używane do określenia, który bit XML. Wszystko, co musisz zrobić, to dołączyć plik XML, a Word zrobi resztę.
Excel ma sposoby na pobieranie danych z niego jako XML, więc całe rozwiązanie powinno działać ładnie.
Jest mnóstwo informacji na temat content control data-binding na MSDN (niektóre z nich zostały wymienione wcześniej, więc pytania), więc nie będę zawracać sobie tym głowy tutaj.
Ale potrzebujesz sposobu na ustawienie wiązań. Możesz użyć zestawu narzędzi kontroli zawartości lub jeśli chcesz to zrobić z poziomu programu Word, mój dodatek OpenDoPE.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2011-02-24 23:06:27
Wykonując podobne zadanie odkryłem, że wstawianie wartości do tabel było znacznie szybsze niż wyszukiwanie nazwanych tagów - dane można wstawiać w następujący sposób:
With oDoc.Tables(5)
For i = 0 To Data.InvoiceDictionary.Count - 1
If i > 0 Then
oDoc.Tables(5).rows.Add
End If
Set invoice = Data.InvoiceDictionary.Items(i)
.Cell(i + 2, 1).Range.Text = invoice.InvoiceCCNumber
.Cell(i + 2, 2).Range.Text = invoice.InvoiceDate
.Cell(i + 2, 3).Range.Text = invoice.TransactionType
.Cell(i + 2, 4).Range.Text = invoice.Description
.Cell(i + 2, 5).Range.Text = invoice.SumOfValue
Next i
.Komórka (i + 1, 4).Zasięg.Tekst = " Razem:" End With w tym przypadku wiersz 1 tabeli był nagłówkiem; wiersz 2 był pusty i nie było kolejnych wierszy - tak więc wiersze.add stosuje się po dołączeniu więcej niż jednego wiersza. Tabele mogą być bardzo szczegółowe dokumenty i ukrywając obramowania i obramowania komórek mogą być wykonane do wygląda jak zwykły tekst. Tabele są numerowane kolejno po obiegu dokumentów. (tj. dok.Tables(1) jest pierwszą tabelą...
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2016-03-18 16:22:25