| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 5714 人关注过本帖
标题:求助VFP如何在EXCEL的thisworkbook中写入宏
取消只看楼主 加入收藏
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
结帖率:87.5%
收藏
已结贴  问题点数:20 回复次数:11 
求助VFP如何在EXCEL的thisworkbook中写入宏
求助VFP如何在EXCEL的thisworkbook中写入宏
搜索更多相关主题的帖子: VFP EXCEL 写入  
2018-10-22 13:28
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
网上查到的这个可以但是,只写入到类模块,我希望能写到Thisworkbook中或Sheet2...中
oXL = Createobject("Excel.Application")
*!* oXL.Visible = .t.
 
oBook=oXL.Workbooks.Add()
oSheet = oBook.Sheets(1)
 
Text to cc Noshow Pretext 1+2
    Public Sub DoKbTest(oSheetToFill As Object)
    Dim i As Integer, j As Integer
    Dim sMsg As String
    For i = 1 To 10
        For j = 1 To 2
            sMsg = Str(i) & "," & Str(j)
            oSheetToFill.Cells(i, j).Value = sMsg
        Next j
    Next i
    End Sub
EndText
 
Try
    oVBE = oXL.VBE.ActiveVBProject
    oErr = Null
Catch To oErr
Endtry
 
If !Isnull(oErr) And oErr.ErrorNo == 1943
    Text to cMsg Noshow Pretext 1+2
        当前的 Excel 配置不允许执行这个宏,请检查 Excel 配置。
 
        请确认勾选了: 可靠发行商中的 “信任对 Visual Basic 项目”的访问
    EndText
    Messagebox(cMsg, 0, '')
    oXL.Visible = .T.
    (1).Controls(6).Controls(14).Controls(3).Execute()
Endif
 
Try
    om = oXL.VBE.ActiveVBProject.VBComponents.Add(1)
    om.CodeModule.AddFromString(cc)
    oXL.Run("DoKbTest", oSheet)
    oXL.Visible = .T.
Catch To oErr
    Messagebox(oErr.Message + 0h0d0a0d0a + '你没有正确设置安全选项。', 0, '')
    oXL.Quit
    oXL = Null
Endtry
收到的鲜花
  • 厨师王德榜2018-10-24 09:47 送鲜花  3朵   附言:好文章,有用!
2018-10-22 15:27
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
om = oXL.VBE.ActiveVBProject.VBComponents.Add(1)
     om.CodeModule.AddFromString(cc)
不知道怎样设置
2018-10-22 15:28
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
还有
1.在“模块1”中插入代码
如果需要在“Sheet1”、“Thisworkbook”、或“Userform1”中操作,用只需将下面的“模块1”换成相应的名称即可。
方法1:
在模块的开始增加代码,增加的代码放在公共声明option,全局变量等后面。
Sub AddCode1()
 ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.AddFromString _
   "sub aTest()" & Chr(10) & _
   "msgbox ""Hello""" & Chr(10) & _
   "end sub"
End Sub
按这个模式编写程序提示错误。
2018-10-22 15:30
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
哪位朋友帮助解决一下,谢谢
2018-10-22 15:31
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
我是说能写入宏代码,只是想写入哪个模块位置,我不知道怎么弄,我想将VBA代码写入Thisworkbook模块中,不知道怎么控制。
2018-10-22 19:49
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
我自己研究出来了,谢谢各位朋友!
2018-10-22 20:04
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
xbm=MyExcel.ActiveSheet.Name
For lnI=1 To MyExcel.Sheets.Count
    If MyExcel.Sheets(lnI).Name==xbm
    Exit
    Endif
Endfor
Mhs=MyExcel.ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule.CountOfLines &&得到Thisworkbook中VBA行数
If Mhs=0
   MyExcel.ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule.InsertLines(1,"Private Sub Workbook_Open()")
   MyExcel.ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule.InsertLines(2,"End sub")
   Mhs=MyExcel.ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule.CountOfLines
Endif
MyExcel.ActiveWorkbook.VBProject.VBComponents("Thisworkbook").CodeModule.InsertLines(Mhs,"Sheet"+Transform(lnI)+[.ScrollArea="$A$1:$]+字母列号+[$]+Transform(行号)+["])
2018-10-23 10:43
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
使用InsertLines可以选择位置插入语句,也可以在InsertLines(行号,“语句”+chr(13)+"语句")
2018-10-23 10:46
yll148
Rank: 2
等 级:论坛游民
威 望:3
帖 子:268
专家分:15
注 册:2012-7-3
收藏
得分:0 
VBProject:代码操作代码之常用语句
一、增加模块
1.增加一个模块,命名为“我的模块”
  ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "我的模块"
  系统常量vbext_ct_StdModule=1
2.增加一个类模块,命名为“我的类”
  ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_ClassModule).Name = "我的类"
  vbext_ct_ClassModule=2
3.增加一个窗体,命名为“我的窗体”
  ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name = "我的窗体"
  vbext_ct_MSForm=3
二、删除模块
1.删除“模块1”
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("模块1")
2.删除窗体“UserForm1”
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("UserForm1")
3.删除类模块“类1”
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("类1")
4.删除所有的窗体
Sub RmvForms()
  Dim vbCmp As VBComponent
  For Each vbCmp In ThisWorkbook.VBProject.VBComponents
    If vbCmp.Type = vbext_ct_MSForm Then ThisWorkbook.VBProject.VBComponents.Remove vbCmp
  Next vbCmp
End Sub
  相关:
  工作表和ThisWorkbook的模块类型为vbext_ct_Document=100
三、增加代码
1.在“模块1”中插入代码
如果需要在“Sheet1”、“Thisworkbook”、或“Userform1”中操作,用只需将下面的“模块1”换成相应的名称即可。
方法1:
在模块的开始增加代码,增加的代码放在公共声明option,全局变量等后面。
Sub AddCode1()
 ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.AddFromString _
   "sub aTest()" & Chr(10) & _
   "msgbox ""Hello""" & Chr(10) & _
   "end sub"
End Sub
方法2:
在模块指定行处增加代码,原代码后移。增加代码不理会和判断插入处代码的内容。当指定行大于最后一行行号时,在最后一行的后面插入。
Sub AddCode2()
  With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
    .InsertLines 1, "sub aTest()"
    .InsertLines 2, "msgbox ""Hello"""
    .InsertLines 3, "end sub"
  End With
End Sub

相关语句:
(1)“模块1”中代码总行数:
ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfLines
(2)“模块1”中代码公共声明部分的行数:
ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfDeclarationLines
(3)显示“模块1”中第1行起的3行代码内容:
Sub ShowCodes()
  Dim s$
  s = ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.Lines(1, 3)
  Debug.Print s
End Sub
(4)过程aTest的起始行数:
ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcBodyLine("aTest", vbext_pk_Proc)
ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcStartLine("aTest", 0)
系统常量vbext_pk_Proc=0
二者的区别是ProcBodyLine返回sub aTest或Function aTest所在的行号,如果sub前面有空行,ProcStartLine返回空行的行号。
(5)过程aTest的总行数:
ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcCountLines("aTest", vbext_pk_Proc)
2.建立事件过程
建立事件过程除了使用上面的代码如下面的AddEventsCode1外,还可以使用CreateEventProc方法,如AddEventsCode2所示。
一般方法:
Sub AddEventsCode1()
  ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString _
    "Private Sub Workbook_Open()" & Chr(13) & _
    "MsgBox ""Hello""" & Chr(13) & _
    "End Sub"
End Sub
CreateEventProc方法:
Sub AddEventsCode2()
  Dim i%
  With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
    i = .CreateEventProc("SelectionChange", "Worksheet") + 1
    .InsertLines i, "Msgbox ""Hello"""
  End With
End Sub
上面CreateEventProc的两个参数建立的事件过程为Worksheet_SelectionChange,分别是下划线两边的内容。
相关:
测试是否存在SelectionChange事件
下面函数测试模块modulname是否存在过程subname,如果存在,则返回起始行号,否则返回0。
debug.print hassub("Worksheet_SelectionChange","Sheet1")
Function HasSub(ByVal subname As String, ByVal modulname As String) As Long
  On Error Resume Next
  Dim i&
  i = ThisWorkbook.VBProject.VBComponents(modulname).CodeModule.ProcBodyLine(subname, 0)
  If Err.Number = 35 Then
    Err.Clear
    HasSub = 0
  Else
    HasSub = i
  End If
End Function
如果存在,则返回起始行号,否则返回0。
四、删除代码
1.删除Sheet1中第2行起的三行代码:
如果只删除1行代码,第二个参数可省略。
Sub DelCodes()
 ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.DeleteLines 2, 3
End Sub
2.删除“模块1”的所有代码:
Sub DelCodes()
 With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
   .DeleteLines 1, .CountOfLines
 End With
End Sub
3.删除过程aTest:
Sub DelCodes()
  With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
   .DeleteLines .ProcStartLine("aTest", 0), .ProcCountLines("aTest", 0)
  End With
End Sub
4.将“模块1”的第5行代码替换为“x=3”
 ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ReplaceLine 5, "x=3"
五、引用项目
1.增加引用
  ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\asctrls.ocx"
2.取消引用
  ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("ASControls")
这里ASControls是引用的名字,即后面的rf.Name。
3.显示当前所有引用
Sub ShowRefs()
  Dim rf As VBIDE.Reference
  For Each rf In ThisWorkbook.VBProject.References
    Debug.Print rf.Name, rf.FullPath
  Next
End Sub
六、信任及密码
上面所有操作都基于这样的前题:
(1)EXCEL已设置:
工具(T)-宏(M)-安全性(M)-可靠发行商(T)-勾选了“信任对于VB项目的访问(V)”
(2)工程没有设置密码
如果不能满足它们中的任何一个,代码运行就会出错。因为微软不希望我们对VBProject进行操作,我们无从知道这种操作的直接方法被藏到了什么地方。幸运的是,微软在关起正门的同时,还是为我们留了一道门:SendKeys。借助于这道后门和“错误陷阱”,我们仍可

以完成我们所要做的事。
下面给出绕开这两道门的示意代码,如果你要运行它们,请记得切回EXCEL主界面,而不是在VBE中直接运行。
1.信任对于VB项目的访问
Sub SetAllowableVbe()
  On Error Resume Next
  Dim Chgset As Boolean
  '陷阱测试,VBProject.Protection在这儿并无实际的意义
  Debug.Print ThisWorkbook.VBProject.Protection
  If Err.Number = 1004 Then
    Err.Clear
    Application.SendKeys "%TMS%T%V{ENTER}"
    Chgset = True
    DoEvents
  End If
  '要执行的操作....
  '.....
  '操作完成后还原操作前的状态
  If Chgset Then Application.SendKeys "%TMS%T%V{ENTER}"
End Sub
2.操作密码工程
Sub AllowPass()
  Dim pw$
  pw = "Password"
  If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then
    Application.(1).Controls("工具(T)").Controls("VBAProject 属性(&E)...").Execute
    Application.SendKeys pw & "{ENTER}{ENTER}"
    DoEvents
  End If
  '要执行的操作….
  '.....
End Sub
Protection属性返回工程的受保护状态,vbext_pp_locked(1)为受保护,vbext_pp_none(0)表示没有保护。


三是至少掌握20个常用函数以及函数的嵌套运用,必须掌握的函数有SUM函数、IF函数、VLOOKUP函数、INDEX函数、MATCH函数、OFFSET函数、TEXT函数等等

Sub hidebar()
(1).Enabled = False
Application.DisplayFullScreen = True
("Full Screen").Visible = False
With ActiveWindow
 .DisplayHorizontalScrollBar = False
 .DisplayVerticalScrollBar = False
End With
End Sub

Sub unhidebar()
(1).Enabled = True
Application.DisplayFullScreen = False
With ActiveWindow
 .DisplayHorizontalScrollBar = True
 .DisplayVerticalScrollBar = True
End With
End Sub
2018-10-23 10:48
快速回复:求助VFP如何在EXCEL的thisworkbook中写入宏
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.018620 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved