runtime error 5854 string parameter is too long
I use following macro and sometimes it gives parameter is too long error. how can I solve it?
Sub BoldFirstLetterInSentence()
Dim s As Range
Dim doc1 As Document
Dim doc2 As Document
Set doc1 = Word.Documents("Doc1.docx")
Set doc2 = Word.Documents("Doc2.docx")
For Each s In doc1.Sentences
If s.Cha开发者_StackOverflow社区racters(1).Bold = True Then
Debug.Print s
With doc2
Selection.Find.ClearFormatting
With Selection.Find
.Text = s
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
a = Selection.Find.Execute
If a = True Then
Selection.Font.Bold = True
End If
End With
End If
Next
End Sub
I figured out an answer to this - hopefully it's of some use 3 years on.
In my application, I'm replacing all occurrences of the string "{Text}" in a document with the replacement text.
The approach is to break the replacement text into "chunks" of 250 characters, and if there are any more chunks remaining, append a new replacement variable ({1} for the first chunk, {2} for the second, etc.), then repeat.
My code below runs in Word 2010 VBA:
Private Sub SearchAndReplace(search As String, replace As String)
Dim i As Integer
Dim chunks As Integer
Dim chunk As String
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst ' Go to the start of the document
With Selection.Find
.ClearFormatting
.MatchCase = True
.MatchWholeWord = True
' We get error 5854 if the replacement text is greater than 255 characters, so need to work around
' How many 250 character "chunks" are there in the replacement text?
chunks = Round(Len(replace) / 250, 0) ' Use 250 to allow for {1}, etc.
If Len(replace) Mod 250 > 0 Then chunks = chunks + 1 ' Workaround because there's no Ceiling()
If chunks = 1 Then
.Execute FindText:="{" & search & "}", ReplaceWith:=replace, replace:=wdReplaceAll
Else
' Replace existing replacement variable (e.g. {Text}) the first chunk's replacement variable (i.e. {1})
.Execute FindText:="{" & search & "}", ReplaceWith:="{1}", replace:=wdReplaceAll
' Replace the text in chunks of less than 255 characters
For i = 1 To chunks
' Get the
chunk = Mid(replace, ((i - 1) * 250) + 1, 250)
' Add the replacement variable for the next chunk to the end of the string
If i < chunks Then chunk = chunk & "{" & (i + 1) & "}"
.Execute FindText:="{" & i & "}", ReplaceWith:=chunk, replace:=wdReplaceAll
Next i
End If
End With
End Sub
The answer is much simpler than those given here. Don't use Replacement. Simply select the text you want to replace, then TYPE over it.
With ActiveDocument.ActiveWindow.Selection
.WholeStory
.Find.ClearFormatting
.Find.Execute FindText:="Whatever you want to replace"
Options.ReplaceSelection = True
.TypeText Text:="Type away to your heart's content. This string can be as long as it needs to be. What you're doing here is selecting the part you want to replace, then just start typing, same as you would if you were using Word for real. Because Selection selects the word you want to replace, when you start typing, that will be replaced with the new text as you type. No need to worry about String length limitations."
End With
' in the archive word, you have put [1], in the place that want to made the change
Dim dirr As String
dirr = ThisWorkbook.Path ' this content url or path of actual archive
Dim objSelection
Dim objWord As Object
If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
End If
Set objDoc = objWord.Documents.Open(dirr & "\a1.dotx") & "TEMPLEATE WORD" ' this content archive WORD or TEMPLEATE.
objWord.Visible = True
Set objSelection = objWord.Selection
' Changes in the "WORD"
Dim cant As Integer
Dim tex As String
Dim max As Integer
Dim total As Integer
Dim final As Integer
final = 1
cant = 1
max = 200 ' this is amount of character that it go have divide, then Visual Basic only allows 250. In this case is 200
'Sheets("Programas").Cells(1, 1).Value. This have the string > 250 Caracters, but it divides in cant = 200.
total = Len(Sheets("Programas").Cells(1, 1).Value) ' this have total characters of the string.
Do While total > (cant) * max
' this "while" divides string in "cant = 200", example 1200 Characters, this "while" divides the string in 6 parts.
With objWord.Selection.Find
.ClearFormatting
.MatchCase = True
.MatchWholeWord = True
.Text = "[1]" ' shearch [1] and replace by "cant = 200"
tex = Mid(Sheets("Programas").Cells(1, 1).Value, final, max) ' this content "cant = 200" characters, actual
.Replacement.Text = tex & "[1]" ' this replace "cant = 200" and finally to add [1],for the next "cant = 200" Characters
cant = cant + 1
final = max * (cant - 1) ' this have the character actual for to divide in "cant = 200", example ---> 0 position ..... "190 Characteres" other 10 Characters ------ THIS IS FINAL = 200 -------- 201 Character -----> NEXT "cant = 200"
.Execute Replace:=2
End With
Loop
'This made the same that prev Procces, in the last "cant = 200"
With objWord.Selection.Find
.ClearFormatting
.MatchCase = True
.MatchWholeWord = True
.Text = "[1]"
tex = Mid(Sheets("Programas").Cells(1, 1).Value, final, total)
.Replacement.Text = tex
.Execute Replace:=2
End With
I believe the maximum length of a replace string in this context is 255 characters. I am guessing that sometimes your sentence length is more than that, which is causing the error. Your best bet is to use smaller chunks of strings for replacement.
Just in case someone is looking for something similar in C#:
private static void ReplaceText(Find find, string findText, string replaceText) {
find.ClearFormatting();
find.Text = findText;
find.Replacement.ClearFormatting();
find.Replacement.Text = replaceText;
object replaceAll = WdReplace.wdReplaceAll;
find.Execute(ref missing, ref missing, ref missing, ref missing, ref missing,
ref missing, ref missing, ref missing, ref missing, ref missing,
ref replaceAll, ref missing, ref missing, ref missing, ref missing);
}
private static void ReplaceTextInRange(Range range, Dictionary<string, string> replacements) {
var find = range.Find;
foreach (var replacement in replacements) {
int maxLen = 255;
if (replacement.Value.Length > maxLen) {
//For longer text, we need to break it up. We use a special delimiter at the end of each chunk to mark the position for the next replacement operation.
const string specialDelim = "{={=}=}";
ReplaceText(find, replacement.Key, specialDelim);
var chunkSize = maxLen - specialDelim.Length;
SplitIntoChunks(replacement.Value, chunkSize, (chunk, i, isLast) =>
ReplaceText(find, specialDelim, chunk + (isLast ? "" : specialDelim))
);
} else {
ReplaceText(find, replacement.Key, replacement.Value);
}
}
}
private static void SplitIntoChunks(string value, int size, Action<string, int, bool> fn) {
var cnt = (int)Math.Ceiling((decimal)value.Length / size);
if (cnt <= 1) {
fn(value, 0, true);
}
for (int i = 0; i < cnt; i++) {
string chunk = value.Substring(i * size, Math.Min(size, value.Length - i * size));
fn(chunk, i, i == cnt - 1);
}
}
In case someone need to handle limit of the word length of the search text. Below is the code to do it:
Private Function SearchAndReplaceText(ByVal StrSearch As String, ByVal StrReplace As String) As Boolean
Dim i As Integer
Dim divisions As Integer
Dim chunk As String
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst ' Go to the start of the document
With Selection.Find
.ClearFormatting
.MatchCase = True
.MatchWholeWord = True
' We get error 5854 if the text property of selection is greater than 255 characters, so need to work around
' How many 250 character "divisions" are there in the search text?
divisions = Round(Len(StrSearch) / 250, 0)
If Len(StrSearch) Mod 250 > 0 Then divisions = divisions + 1
If divisions = 1 Then
.Execute Findtext:=StrSearch, ReplaceWith:=StrReplace, Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
SearchAndReplaceText = True
Else
' Replace the text in divisions of less than 255 characters
For i = 1 To divisions
' Get the text chunk by chunk
chunk = Mid(StrSearch, ((i - 1) * 250) + 1, 250)
.Execute Findtext:=chunk, ReplaceWith:=StrReplace, Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
Next i
SearchAndReplaceText = True
End If
End With
End Function
here is a possible solution.
Selection.Find.Execute FindText:="MonTexte"
Selection.Range.Text = "abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg abcefg"
精彩评论