出问题：用代码操作代码

weiyingde

Excel文件和Word文档都已打开，运行Excel上的过程，将过程写到word的project上。
Excel上的代码如下：
Public Sub 写入wd(adoc As Word.Document)
adoc.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "输到word"
isr = "Public Nubr" & Chr(10)
isr = isr & "Public Sub 格式文档(adoc As Word.Document)" & Chr(10)
isr = isr & "rd = Int(Rnd * 7 + 1)" & Chr(10)
isr = isr & "Nubr = Nubr + 1" & Chr(10)
isr = isr & "md = Nubr Mod 2 + 1" & Chr(10)
isr = isr & "Cld = Array(1, 2, 4, 5, 6, 9, 12, 13)(rd)" & Chr(10)
isr = isr & "Cld = Choose(md, Cld, 8)" & Chr(10)
isr = isr & "With adoc" & Chr(10)
isr = isr & Space(4) & "With .Content.Find" & Chr(10)
isr = isr & Space(8) & ".Font.Underline = wdUnderlineWavy" & Chr(10)
isr = isr & Space(8) & ".Replacement.Font.ColorIndex = Cld" & Chr(10)
isr = isr & Space(8) & ".Execute Replace:=wdReplaceAll" & vbCrLf
isr = isr & Space(4) & "End With" & Chr(10)
isr = isr & Space(4) & "For Each tbl In .Tables" & Chr(10)
isr = isr & Space(8) & "With tbl" & Chr(10)
isr = isr & Space(12) & "For i = 1 To .Rows.Count" & Chr(10)
isr = isr & Space(16) & "For j = 1 To .Columns.count" & Chr(10)
isr = isr & Space(16) & "End If" & Chr(10) & Space(6) & "Next j" & Chr(10)
isr = isr & Space(16) & ".Cell(i, j).Range.ParagraphFormat.Alignment = IIf(md = 1, wdAlignParagraphCenter, wdAlignParagraphLeft)" & Chr(10)
isr = isr & Space(16) & "For Each sr In .Cell(i, j).Range.Characters" & Chr(10)
isr = isr & Space(20) & "If sr Like ""[A-Z]"" Then" & Chr(10)
isr = isr & Space(24) & "With sr.Font" & Chr(10)
isr = isr & Space(28) & ".Size = 10.5" & Chr(10)
isr = isr & Space(28) & ".Name = ""Arial Black""" & Chr(10)
isr = isr & Space(28) & ".ColorIndex = Cld" & Chr(10)
isr = isr & Space(24) & "End With" & Chr(10)
isr = isr & Space(20) & "End If" & Chr(10)
isr = isr & Space(16) & "Next" & Chr(10)
isr = isr & Space(12) & "Next" & Chr(10)
isr = isr & Space(8) & "Next" & Chr(10)
isr = isr & Space(4) & "End With" & Chr(10)
isr = isr & Space(4) & "Next" & Chr(10)
isr = isr & Space(4) & "With .Content.Find" & Chr(10)
isr = isr & Space(8) & "Do While .Execute(""[\(（][A - D]{1,}[\)）]^13"", , , 1)" & Chr(10)
isr = isr & Space(12) & "With .Parent" & Chr(10)
isr = isr & Space(16) & ".MoveStart wdCharacter, 1" & Chr(10)
isr = isr & Space(16) & ".MoveEnd wdCharacter, -2" & Chr(10)
isr = isr & Space(16) & ".Font.Name = ""Arial Black""" & Chr(10)
isr = isr & Space(16) & ".Font.Size = 10.5" & Chr(10)
isr = isr & Space(16) & ".Font.ColorIndex = Cld" & Chr(10)
isr = isr & Space(16) & ".Collapse 0" & Chr(10)
isr = isr & Space(12) & "Loop" & Chr(10)
isr = isr & Space(8) & "End With" & Chr(10)
isr = isr & Space(4) & "End With" & Chr(10)
isr = isr & Space(0) & "End Sub" & Chr(10)
adoc.VBProject.VBComponents("输到word").CodeModule.AddFromString isr
End Sub
要求：运行以后将在word的project上写入以下代码：
Public Nubr
Public Sub 格式文档(adoc As Word.Document)
rd = Int(Rnd * 7 + 1)
Nubr = Nubr + 1
md = Nubr Mod 2 + 1
Cld = Array(1, 2, 4, 5, 6, 9, 12, 13)(rd)
Cld = Choose(md, Cld, 8)
With adoc
     With .Content.Find
          .Font.Underline = wdUnderlineWavy
          .Replacement.Font.ColorIndex = Cld
          .Execute Replace:=wdReplaceAll
     End With
     For Each tbl In .Tables
         With tbl
             For i = 1 To .rows.count
                 For j = 1 To .Columns.count
                     .Cell(i, j).Range.ParagraphFormat.Alignment = IIf(md = 1, wdAlignParagraphCenter, wdAlignParagraphLeft)
                     For Each sr In .Cell(i, j).Range.Characters
                        If sr Like "[A-Z]" Then
                           With sr.Font
                                  .Size = 10.5
                                  .Name = "Arial Black"
                                  .ColorIndex = Cld
                           End With
                        End If
                     Next
                 Next
             Next
         End With
     Next
     With .Content.Find
         Do While .Execute("[\(（][A-D]{1,}[\)）]^13", , , 1)
            With .Parent
                 .MoveStart wdCharacter, 1
                 .MoveEnd wdCharacter, -2
                 .Font.Name = "Arial Black"
                 .Font.Size = 10.5
                 .Font.ColorIndex = Cld
                 .Collapse 0
             End With
         Loop
     End With
End With
End Sub。
出现的问题如下：

weiyingde

附件如下，请大侠路过试试，先谢了。

lss001

Sub 调用写入wd过程()
Dim wd As Object, doc As Document
Set wd = GetObject(, "Word.Application")
Set doc = wd.ActiveDocument
Call 写入wd(doc)
Msgbox "写入完成!"
End Sub

后期引用把vbext_ct_StdModule替换为1↓
aodc.VBProject.VBComponents.Add(1).Name = "输出到word"

weiyingde

再次央请大侠援手，我已经试了多遍，没有成功，始终找不出原因，觉得十分蹊跷。

loquat

试试Activedocument.VBProject.VBComponents.Add(1)

weiyingde

loquat 发表于 2025-2-24 16:23
试试Activedocument.VBProject.VBComponents.Add(1)

谢谢大侠回复。疑虑还是没消除：同样的过程，我在word project 向Excel project写入没有问题，可是此处为什么有问题。
请大侠用附件在你的电脑上试一试，给出指导甚至分析。

batmanbbs

大概率和引用库有关系，excel vbe可能没有引用word库，所以需要修改两个地方：
一是将as word.document 修改 as object
二是将vbext_ct_StdModule修改为1（楼上两位老师都指出了）
PS：我已经测试通过。

weiyingde

batmanbbs 发表于 2025-2-24 18:41
大概率和引用库有关系，excel vbe可能没有引用word库，所以需要修改两个地方：
一是将as word.document 修 ...

xianxiele,大侠厉害。

weiyingde

三位大侠：“vbext_ct_StdModule”的常量不是“1”，难道两者还有差别吗？

lss001

weiyingde 发表于 2025-2-24 20:56
三位大侠：“vbext_ct_StdModule”的常量不是“1”，难道两者还有差别吗？

VBIDE库↓
Microsoft Visual Basic for Applications Extensibility 5.3
查看一下以上库对象