admin管理员组文章数量:1221291
I am trying to iteratively generate project sheets row by row in an excel. Some columns have long descriptions so wrote an additional sub function to handle the long text strings. I believe an error occurs in the line below. I added the optional as well in case some rows do not have descriptions.
Sub ReplaceLongText(ByRef doc As Word.Document, Optional ByVal k As Integer)
Full code:
Sub createPDFs()
Dim wd As Word.Application
Dim doc As Word.Document 'Ensure doc is Explicitly Declared as Word.Document
Dim docPath As String
Dim i As Integer ' Explicitly declare i as Integer
' Must Network Sharepoint site to computer to create a working path
docPath = "C:\Users\obergmann\Project Sheet Generation/R&M_ProjectSheetTemplate.docx"
Set wd = New Word.Application
wd.Visible = True
On Error GoTo ErrorHandler
' For loop to iteratively cycle through row numbers:
For i = 8 To 10
' Locate the template
Set doc = wd.Documents.Open(docPath)
' Standard text replacements
With wd.Selection.Find
.Text = "<<Recommendation Number>>"
.Replacement.Text = Cells(i, 1).Value
.Execute Replace:=wdReplaceAll
End With
' I have several more wd.Selection.Find after this
' Call the function to handle long text replacements
Call ReplaceLongText(doc, i)
' Save the Word document
Dim wordFileName As String
wordFileName = ActiveWorkbook.Path & "\" & Cells(i, 2).Value & "_" & Cells(i, 1).Value & ".docx"
doc.SaveAs2 fileName:=wordFileName, FileFormat:=wdFormatDocumentDefault
' export as pdf
doc.ExportAsFixedFormat OutputFileName:=ActiveWorkbook.Path & "\" & Cells(i, 2).Value & "_" & Cells(i, 1).Value & ".pdf", _
ExportFormat:=wdExportFormatPDF
Application.DisplayAlerts = False
doc.Close SaveChanges:=False
Next i
wd.Quit
Application.DisplayAlerts = True
Exit Sub
ErrorHandler:
MsgBox "An error occurred: " & Err.description
If Not doc Is Nothing Then doc.Close False
If Not wd Is Nothing Then wd.Quit
Application.DisplayAlerts = True
End Sub
Function SanitizeFileName(fileName As String) As String
Dim invalidChars As String
invalidChars = ":\/?*""<>|"
Dim i As Integer
For i = 1 To Len(invalidChars)
fileName = Replace(fileName, Mid(invalidChars, i, 1), "_")
Next i
SanitizeFileName = fileName
End Function
`Then here is the next function:
Sub ReplaceLongText(ByRef doc As Word.Document, Optional ByVal k As Integer) ' I think this is the line with issues
Dim placeholders As Variant
Dim columnIndices As Variant
Dim description As String
Dim chunkSize As Integer
Dim startPos As Integer
Dim chunk As String
Dim j As Integer
Dim rng As Range ' Create a range object
' Define placeholders and corresponding column indices
placeholders = Array("<<Description>>", _
"<<Public Health & Safety - Compliance Driven Rationale>>", _
"<<Reliability & Resiliency Rationale>>", _
"<<Community Enrichment/Growth Rationale>>", _
"<<Financial Stewardship Rationale>>", _
"<<Efficiency, Modernization, & Environment Rationale>>", _
"<<Level of Service Rationale>>", _
"<<Additional Prioritization Notes>>", _
"<<Funding Source>>")
columnIndices = Array(3, 12, 13, 14, 15, 16, 17, 18, 27) ' Corresponding Excel column numbers
chunkSize = 255 ' Max characters per chunk
' Loop through all placeholders
For j = LBound(placeholders) To UBound(placeholders)
description = Cells(k, columnIndices(j)).Value
startPos = 1
' Set the range to search in the document
Set rng = doc.Content
With rng.Find
.Text = placeholders(j) ' Set text to find
.Forward = True
.Wrap = wdFindStop
' Execute the search
If .Execute Then
' Set range to the found text
Set rng = doc.Range(rng.Start, rng.End)
rng.Text = "" ' Clear only the placeholder text
' Insert text in chunks
Do While startPos <= Len(description)
chunk = Mid(description, startPos, chunkSize)
rng.InsertAfter Text:=chunk
startPos = startPos + chunkSize
Loop
End If
End With
Next j
End Sub
I am trying to iteratively generate project sheets row by row in an excel. Some columns have long descriptions so wrote an additional sub function to handle the long text strings. I believe an error occurs in the line below. I added the optional as well in case some rows do not have descriptions.
Sub ReplaceLongText(ByRef doc As Word.Document, Optional ByVal k As Integer)
Full code:
Sub createPDFs()
Dim wd As Word.Application
Dim doc As Word.Document 'Ensure doc is Explicitly Declared as Word.Document
Dim docPath As String
Dim i As Integer ' Explicitly declare i as Integer
' Must Network Sharepoint site to computer to create a working path
docPath = "C:\Users\obergmann\Project Sheet Generation/R&M_ProjectSheetTemplate.docx"
Set wd = New Word.Application
wd.Visible = True
On Error GoTo ErrorHandler
' For loop to iteratively cycle through row numbers:
For i = 8 To 10
' Locate the template
Set doc = wd.Documents.Open(docPath)
' Standard text replacements
With wd.Selection.Find
.Text = "<<Recommendation Number>>"
.Replacement.Text = Cells(i, 1).Value
.Execute Replace:=wdReplaceAll
End With
' I have several more wd.Selection.Find after this
' Call the function to handle long text replacements
Call ReplaceLongText(doc, i)
' Save the Word document
Dim wordFileName As String
wordFileName = ActiveWorkbook.Path & "\" & Cells(i, 2).Value & "_" & Cells(i, 1).Value & ".docx"
doc.SaveAs2 fileName:=wordFileName, FileFormat:=wdFormatDocumentDefault
' export as pdf
doc.ExportAsFixedFormat OutputFileName:=ActiveWorkbook.Path & "\" & Cells(i, 2).Value & "_" & Cells(i, 1).Value & ".pdf", _
ExportFormat:=wdExportFormatPDF
Application.DisplayAlerts = False
doc.Close SaveChanges:=False
Next i
wd.Quit
Application.DisplayAlerts = True
Exit Sub
ErrorHandler:
MsgBox "An error occurred: " & Err.description
If Not doc Is Nothing Then doc.Close False
If Not wd Is Nothing Then wd.Quit
Application.DisplayAlerts = True
End Sub
Function SanitizeFileName(fileName As String) As String
Dim invalidChars As String
invalidChars = ":\/?*""<>|"
Dim i As Integer
For i = 1 To Len(invalidChars)
fileName = Replace(fileName, Mid(invalidChars, i, 1), "_")
Next i
SanitizeFileName = fileName
End Function
`Then here is the next function:
Sub ReplaceLongText(ByRef doc As Word.Document, Optional ByVal k As Integer) ' I think this is the line with issues
Dim placeholders As Variant
Dim columnIndices As Variant
Dim description As String
Dim chunkSize As Integer
Dim startPos As Integer
Dim chunk As String
Dim j As Integer
Dim rng As Range ' Create a range object
' Define placeholders and corresponding column indices
placeholders = Array("<<Description>>", _
"<<Public Health & Safety - Compliance Driven Rationale>>", _
"<<Reliability & Resiliency Rationale>>", _
"<<Community Enrichment/Growth Rationale>>", _
"<<Financial Stewardship Rationale>>", _
"<<Efficiency, Modernization, & Environment Rationale>>", _
"<<Level of Service Rationale>>", _
"<<Additional Prioritization Notes>>", _
"<<Funding Source>>")
columnIndices = Array(3, 12, 13, 14, 15, 16, 17, 18, 27) ' Corresponding Excel column numbers
chunkSize = 255 ' Max characters per chunk
' Loop through all placeholders
For j = LBound(placeholders) To UBound(placeholders)
description = Cells(k, columnIndices(j)).Value
startPos = 1
' Set the range to search in the document
Set rng = doc.Content
With rng.Find
.Text = placeholders(j) ' Set text to find
.Forward = True
.Wrap = wdFindStop
' Execute the search
If .Execute Then
' Set range to the found text
Set rng = doc.Range(rng.Start, rng.End)
rng.Text = "" ' Clear only the placeholder text
' Insert text in chunks
Do While startPos <= Len(description)
chunk = Mid(description, startPos, chunkSize)
rng.InsertAfter Text:=chunk
startPos = startPos + chunkSize
Loop
End If
End With
Next j
End Sub
Share
Improve this question
edited Feb 7 at 0:31
Ken White
126k15 gold badges235 silver badges463 bronze badges
asked Feb 6 at 20:33
olivia bergmannolivia bergmann
1
New contributor
olivia bergmann is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
2
|
1 Answer
Reset to default 0You can simplify and use one method for all replacements. Here's a basic example:
Sub Tester()
Const docpath As String = "C:\Temp\Template.docx"
Dim ws As Worksheet, rw As Range, doc As Word.Document, placeHolders, j As Long
Dim wd As Word.Application
Set wd = New Word.Application
wd.Visible = True
' Define placeholders and corresponding column indices
' #### a bit easier like this, as one array and loop every second index
placeHolders = Array("<<Recommendation Number>>", 1, _
"<<Description>>", 3, _
"<<Public Health & Safety - Compliance Driven Rationale>>", 12, _
"<<Reliability & Resiliency Rationale>>", 13, _
"<<Community Enrichment/Growth Rationale>>", 14, _
"<<Financial Stewardship Rationale>>", 15, _
"<<Efficiency, Modernization, & Environment Rationale>>", 16, _
"<<Level of Service Rationale>>", 17, _
"<<Additional Prioritization Notes>>", 18, _
"<<Funding Source>>", 27)
Set ws = ActiveSheet
For Each rw In ws.Range("8:10").Rows
Set doc = wd.Documents.Open(docpath)
ResetFindParameters doc.Range 'reset `Find` settings
' Loop through all placeholders
For j = LBound(placeHolders) To UBound(placeHolders) Step 2
'perform the replace
ReplaceAllInDoc doc, CStr(placeHolders(j)), _
CStr(rw.Cells(placeHolders(j + 1)).Value)
Next j
'save the doc here...
doc.Close False
Next rw
End Sub
'In word document `doc`, replace all instances of `findWhat` with `replaceWith`
Sub ReplaceAllInDoc(doc As Word.Document, findWhat As String, replaceWith As String)
Dim rng As Word.Range, col As New Collection
Set rng = doc.Range
With rng.Find
Do While .Execute(findtext:=findWhat)
col.Add rng.Duplicate 'collect found matches
Loop
End With
For Each rng In col 'replace all matches
rng.Text = replaceWith
Next rng
End Sub
'reset any settings from previous `Find` uses...
Sub ResetFindParameters(rng As Word.Range)
With rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False '<<
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
本文标签: excelArgument Not Optional is not working How can I fixStack Overflow
版权声明:本文标题:excel - Argument Not Optional is not working. How can I fix? - Stack Overflow 内容由网友自发贡献,该文观点仅代表作者本人, 转载请联系作者并注明出处:http://www.betaflare.com/web/1739361878a2159858.html, 本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容,一经查实,本站将立刻删除。
description = Cells(k, columnIndices(j)).Value
how can k be optional here? – Tim Williams Commented Feb 6 at 20:34Do While Loop
ifLen(description) = 0
. Either use If/Endif or add And egDo While startPos <= Len(description) And Len(description) > 0
. Remove the Optional. – CDP1802 Commented Feb 6 at 21:31