ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
新浪微博登陆 只需一步, 快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微99uu优优 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 393|回复: 14
打印 上一主题 下一主题

[分享] VB6封装EXE文件运行Excel代码教程

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2017-5-31 06:54 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 microyip 于 2017-5-31 06:55 编辑

刚刚昨天看到一个关于“Excel封装EXE的VBA”的贴,利用EXE文件直接对未开启低宏安全的Excel执行代码的好贴。或许很多人想看看如何做到的。在此向大家介绍操作方式。

开发工具:VB6精简版
如果没有安装的,可以下载附件进行安装。当然这个开发工具也可以封装ActiveX DLL文件哦。 vb6精简版.part1.rar (2 MB, 下载次数: 41) vb6精简版.part2.rar (2 MB, 下载次数: 57) vb6精简版.part3.rar (1.86 MB, 下载次数: 46)


代码准备:(在附件 VB6直接启动未设置宏安全的Excel代码(By.Micro).rar (12.05 KB, 下载次数: 40) 里Excel工作簿内有代码可以复制)
  • Option Explicit
  • Sub Main()
  •     Dim sPath As String
  •     Dim ExcelApp As Excel.Application '定义ExcelApp为Excel程序对象
  •     Dim bCreatApp As Boolean
  •     Dim wWB As Workbook
  •    
  •     sPath = App.Path & "" '获取当前Exe文件所在文件夹
  •     On Error Resume Next '遇到出错时执行下一语句
  •     Set ExcelApp = GetObject(, "Excel.Application") '获取已经打开的Excel程序
  •     bCreatApp = ExcelApp Is Nothing '判断是否获取了Excel程序,如果ExcelApp是Nothing时表示Excel程序没有被运行
  •     On Error GoTo 0 '恢复出错时提示错误并停止执行功能
  •     If bCreatApp Then '没有运行Excel程序时
  •         Set ExcelApp = CreateObject("Excel.Application") '运行Excel程序
  •         ExcelApp.Visible = True '将Excel程序界面显示出来
  •     End If
  •     With ExcelApp '在Excel程序里
  •         If bCreatApp Then
  •             Set wWB = .Workbooks.Add '新建一个Excel工作簿
  •             With wWB '在新建的Excel工作簿内
  •                 With .Sheets(1) '在第一个表内
  •                     .[A1] = .[A1] + 1
  •                 End With
  •                 .SaveAs sPath & "VB6测试程序(By.Micro).xlsx" '保存工作簿
  •                 .Close '关闭工作簿
  •             End With
  •         Else
  •             Set wWB = .Workbooks.Open(sPath & "VB6测试程序(By.Micro).xlsm") '打开已有的工作簿
  •             .Run "测试程序" '运行工作簿内已有过程
  •             wWB.Close True '关闭并保存工作簿
  •         End If
  •         If bCreatApp Then .Quit '如果原本没有运行Excel程序时关闭Excel程序
  •     End With
  • End Sub
  • 复制代码
    上述代码只是演示用,大家可以根据自己实际需要进行相关修改。

    生成EXE文件
    打开VB6开发工具,新建“标准 EXE”,对右边“工程-工程1”窗口进行操作
    1、对着“工程1”右键,“工程1 属性”,“启动对象”改为“Sub Main”,“工程名称”改为你想要的名字,本演示里改为“VB6直接启动未设置宏安全的Excel代码”,确定
    2、对着窗体“Form1”右键——移除,
    3、右键“添加”——“添加模块”,在模块代码窗口里把代码复制粘帖进去。
    4、VB6的菜单“工程”——“引用”,把代表Excel程序的“Microsoft Excel 14.0 Object Library”勾上。(这个是Excel2010版本的,如果是其他版本,可以对应勾上Microsoft Excel xx.0 Object Library)
    5、VB6的菜单“文件”——“生成VB6直接启动未设置宏安全的Excel代码.EXE”——选择保存位置后
    成功生成一个EXE文件了,你来试试?


    评分

    参与人数 4鲜花 +11 收起 理由
    jsgj2023 + 3 感谢帮助
    lzqlaj + 3 优秀作品
    yeminqiang + 3 太强大了
    鄂龙蒙 + 2 优秀作品
    查看全部评分
    分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
    收藏收藏11 分享分享 有用有用 无用无用 分享到新浪微博
    TA的精华主题TA的得分主题
    2
    发表于 2017-5-31 07:09 来自手机 | 只看该作者
    有没有试过用你这个启动64位excel
    TA的精华主题TA的得分主题
    3
     楼主| 发表于 2017-5-31 07:12 | 只看该作者 |楼主
    liucqa 发表于 2017-5-31 07:09
    有没有试过用你这个启动64位excel

    尚未试过,因为安装的都是32位office呢,请指正
    TA的精华主题TA的得分主题
    4
    发表于 2017-5-31 15:02 | 只看该作者
    谢谢楼主浏览本人的帖子,代码大概如此。没有工作簿新建一个,并填写单元格内容,有则打开。
    TA的精华主题TA的得分主题
    5
     楼主| 发表于 2017-5-31 15:06 | 只看该作者 |楼主
    lzqlaj 发表于 2017-5-31 15:02
    谢谢楼主浏览本人的帖子,代码大概如此。没有工作簿新建一个,并填写单元格内容,有则打开。

    你的贴是好贴,好建议,好做法。我的只是效仿一下而已。至于是新开工作簿还是打开现有工作簿,纯粹是一个示范,实操的朋友们可以根据自己具体需求变通。
    TA的精华主题TA的得分主题
    6
    发表于 2017-5-31 15:15 | 只看该作者
    microyip 发表于 2017-5-31 15:06
    你的贴是好贴,好建议,好做法。我的只是效仿一下而已。至于是新开工作簿还是打开现有工作簿,纯粹是一个 ...

    互相学习。
    TA的精华主题TA的得分主题
    7
    发表于 2017-5-31 15:21 | 只看该作者
    Private Sub Form_Load()
        Dim xlApp As Excel.Application    'Excel对象
        Dim xlbook As Excel.Workbook    '工作簿
        Dim xlsheet As Excel.Worksheet    '工作表
       ' retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX + 400, Me.CurrentY + 10, 249, 131, SWP_SHOWWINDOW)
        On Error Resume Next
        If IsFileExists(App.Path & "\" & "三小学生个人成绩前N名.xls") = True Then
            Set xlApp = GetObject(, "Excel.Application")     '判断Excel是否打开
            If Err.Number <> 0 Then    '如果未打开
                ' 文件存在时的处理
                Set ObjExcel = CreateObject("Excel.Application")    '第一层
                ObjExcel.Workbooks.Open (App.Path & "\" & "三小学生个人成绩前N名.xls")    ', , , , "987654321", "987654321"
                '显示打开对象
                ObjExcel.Visible = True
                '释放对象
                Set ObjExcel = Nothing
                Err.Clear
            End If
        Else
            ' 文件不存在时的处理
            Set xlApp = CreateObject("excel.application")    '第一层
            Set xlbook = xlApp.Workbooks.Add
            xlApp.Visible = True
            xlbook.Sheets(1).Name = "年级前30名"
            xlbook.Sheets(1).Range("a1") = "年级前30名"
            xlbook.Sheets(1).Range("a2") = "班级"
            xlbook.Sheets(1).Range("b2") = "姓名"
            xlbook.Sheets(1).Range("c2") = "语文"
            xlbook.Sheets(1).Range("d2") = "数学"
            xlbook.Sheets(1).Range("e2") = "英语"
            xlbook.Sheets(1).Range("f2") = "科学"
            xlbook.Sheets(1).Range("g2") = "总分"
            xlbook.Sheets(1).Range("h2") = "名次"
            xlbook.SaveAs App.Path & "\" & "三小学生个人成绩前N名.xls"
            'xlbook.Close
            'xlbook.Sheets(1).Range("A2").FormulaR1C1 = "=IF(RC[2]<>"""",ROW()-1,"""")"
            'xlbook.Sheets(1).Range("A2").AutoFill Destination:=Range("A2:A602"), Type:=xlFillDefault
        End If
        If FolderExists(App.Path & "\" & "各班") = False Then
            ' If Dir(BackuPath, vbDirectory) = "" Then '文件夹不存在
            MkDir (App.Path & "\" & "各班")     '在应用程序根目下,创建文件夹Backup
        End If
    End Sub
    Function IsFileExists(ByVal strFileName As String) As Boolean
        Dim objFileSystem As Object
        Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        If objFileSystem.FileExists(strFileName) = True Then
            IsFileExists = True
        Else
            IsFileExists = False
        End If
    End Function
    Public Function FileExists(ByVal File As String) As Boolean
        On Error Resume Next
        If (GetAttr(File) And vbDirectory) = False Then FileExists = True
        If Err Then FileExists = False: Err.Clear
    End Function
    Function FolderExists(ByVal Folder As String) As Boolean
        On Error Resume Next
        If GetAttr(Folder) And vbDirectory Then FolderExists = True
        If Err Then FolderExists = False: Err.Clear
    End Function

    评分

    参与人数 1鲜花 +3 收起 理由
    microyip + 3 优秀作品
    查看全部评分
    TA的精华主题TA的得分主题
    8
    发表于 2017-5-31 15:25 | 只看该作者
    TA的精华主题TA的得分主题
    9
     楼主| 发表于 2017-5-31 15:27 | 只看该作者 |楼主
    lzqlaj 发表于 2017-5-31 15:21
    Private Sub Form_Load()
        Dim xlApp As Excel.Application    'Excel对象
        Dim xlbook As Excel.W ...

    建议把Form_Load过程名改为Main放模块里,程序启动使用Sub_Main即可,原先的窗体就无需存在,文件相对会缩小一丁点大小,使用时内存也相应少一丁点。
    TA的精华主题TA的得分主题
    10
    发表于 2017-5-31 17:37 | 只看该作者
    本帖最后由 lzqlaj 于 2017-5-31 17:40 编辑
    microyip 发表于 2017-5-31 15:27
    建议把Form_Load过程名改为Main放模块里,程序启动使用Sub_Main即可,原先的窗体就无需存在,文件相对会 ...

    这个建议好。在http://club.excelhome.net/thread-1057015-1-1.html这个帖子里可以参考这个建议。
    您需要登录后才可以回帖 登录 | 免费注册 新浪微博登陆
    本版积分规则
    关闭

    最新热点上一条 /1 下一条

    关注官方微信,每天坐享新鲜教程
    手机版|关于我们|联系我们|ExcelHome    GMT+8, 2017-8-21 22:01 , Processed in 0.080470 second(s), 22 queries , Gzip On, MemCache On.
    Powered by Discuz! X3.3 © 2001-2017 Wooffice Inc.
        沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
    快速回复 返回顶部 返回列表
    99uu优优