Excel生成word文件遇到的问题

鱼生

我写了一个由excel表中导出数据至word的小程序

但是遇到了这样的问题：两台不同的电脑运行结果不一样，家中的Office版本是2019，可以正常运行，在UserForm2.TextBox2中无论输入多少个字符都可以正常运行，但单位的电脑，Office版本是2016，运行时在录入相同的内容时，.Replacement.text = cellValue就会报错：运行时错误5854'’：字符串参量过长。

我在Len计算了一下，如果121个一下就能输出，288个字符就报错

我在网上查了，说好像是由于TextBox有字符限制，刚才我把单位的Office也装成了2019（但估计具体版本与家中不同），运行依旧报错


我现在能想到的方法就是回家把家中的Office版本装到单位的电脑上，但这个程序我存在U盘中，有可能在任意一台电脑上使用，这种不太现实，烦请各位老师帮我看看，到底如何避免这个问题。谢谢各位！

lss001

建议把Find↓
With WordApp.Selection.Find
    ..............................
End With

修改为Replace↓
Dim r$, s$, t& '**********
t = WordDoc.Words.Count
s = WordDoc.Range(0, WordDoc.Words(t).End)
r = Replace(s, "数据" & Format(i, "000"), cellValue)
WordDoc.Range(0, WordDoc.Words(t).End) = r

鱼生

lss001 发表于 2025-1-11 13:51
建议把Find↓
With WordApp.Selection.Find
    ..............................

感谢帮助，根据您的指导，我增加了一个设置word样式的函数。解决需求

CBWSY

.Replacement.Text = "" ' 不要替换的文字，只查找

CBWSY

With WordApp.Selection.Find
             .Text =“数据”&Format(i，“000”) '查找被替换的文字
            .Replacement.Text = "" '不替换，只查找
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = False '通配符关闭
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute
            If .Found Then
                '查找定位\替换
                  Selection.TypeText RplText
               End If
     END WITH

CBWSY

With WordApp.Selection.Find
            .text=“数据”&Format(i，“000") '查找被替换的文字
            .Replacement.Text = "" 只查找不替换
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = False '通配符关闭
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute
            If .Found Then
                  '查找定位\替换
                  Selection.TypeText RplText
             End If
            
     End With

鱼生

CBWSY 发表于 2025-1-13 13:10
With WordApp.Selection.Find
            .text=“数据”&Format(i，“000") '查找被替换的文字
        ...

……      
        With WordApp.Selection.Find
            .text = "数据" & Format(i, "000") '查找被替换的文字
            .Replacement.text = "" '只查找不替换
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchWildcards = False '通配符关闭
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute
            If .found Then
                  '查找定位\替换
                  Selection.TypeText cellValue
             End If
         End With
根据您提供的，这种运行Selcection.TypeText cellValue会报错

CBWSY

WordApp.Selection.TypeText cellValue

鱼生

CBWSY 发表于 2025-1-14 13:14
WordApp.Selection.TypeText cellValue

根据您的帮助，可以正常运行，我做些改动，如果出现两个以上“数据001”，原代码只会替换第一个。修改后目前正常，明天去单位测试一下，看看单位电脑是否可行。如果可以我就可以编辑说明了，越想越开心，非常感谢！

1. With WordApp.Selection.Find
   
2.     .text = "数据" & Format(i, "000") '查找被替换的文字
   
3.     .Replacement.text = "" '只查找不替换
   
4.     .Forward = True
   
5.     .Wrap = wdFindContinue
   
6.             .Format = False
   
7.             .MatchCase = False
   
8.             .MatchWholeWord = False
   
9.             .MatchByte = True
   
10.             .MatchWildcards = False '通配符关闭
    
11.             .MatchSoundsLike = False
    
12.             .MatchAllWordForms = False
    
13.             Do
    
14.     .Execute
    
15.     found = .found
    
16.     If found Then
    
17.         WordApp.Selection.Delete ' 删除找到的文本
    
18.         WordApp.Selection.TypeText cellValue ' 插入替换文本
    
19.         If WordApp.Selection.Start = WordApp.ActiveDocument.Content.End - 1 Then
    
20.             WordApp.Selection.Collapse Direction:=wdCollapseStart
    
21.         End If
    
22.     End If
    
23.             Loop While found ' 只要找到匹配项就继续循环

复制代码

lss001

'以下查找替换另一方式
Sub word查找替换()
    Dim ht As Object, cp As Object
    Set ht = CreateObject("htmlfile")
    Set cp = ht.parentWindow.ClipboardData
    Selection.HomeKey 6, 0
    Do
        cp.ClearData "Text"
        cp.SetData "Text", cellValue
        Selection.Find.Execute "数据" & Format(i, "000")
        If Selection.Find.Found Then
            Selection.Paste
        Else
            Exit Do
        End If
    Loop
   
    Set ht = Nothing
    Set cp = Nothing
End Sub