[原创]XLS封装成EXE制作全攻略

keelung

原帖由 keelung 于 2008-12-31 15:12 发表

很多人问这个问题,我也是,结果我试验了好几种情况,才发现问题所在,原因是出现这些问题的xls文件都是将窗体作为前台,而将excel表格作为后台隐藏了.(在workbook open事件中直接显示窗体,而且workbook.visible=false) ...

怎么没人回答啊?教教我吧!

zhj1978

GetTempFile() 未定义

wuyxdq

保留贴。正需要

xlg5898

高 实在是高

peter-chen

谢谢!学习了!

hbhsmny

牛啊牛啊牛啊牛啊牛啊牛啊牛啊牛啊牛啊牛啊牛啊牛啊

hank2611

'一、用VB制作EXE文件头部分 1、打开VB，“文件”-“新建工程”-“标准EXE”； _
2、此时会出现名为Form1的默认窗体编辑窗口，Form1将作为软件启动封面窗体， _
打开该Form1的属性窗口，对如下属性进行设置：BorderStyle=0，StartUpPosition=2， _
Icon与Picture属性设置成你需要的图标（这也将成为你EXE的图标）和设计好准备使用的图片（即软件封面）， _
窗体的大小设置成您需要的合适值即可。 3、往窗体中添加一个时钟控件timer1，并将其InterVal属性设为1000。 _
4、双击窗体打开代码编辑窗口，录入以下代码：
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260
Private Const EXE_SIZE = 81920 '本EXE实际字节大小
Private Type FileSection
Bytes() As Byte
End Type
Private Type SectionedFile
Files() As FileSection
End Type
Dim StopTime As Integer
Private Sub Form_Activate()
If Command() = "" Then Main1
End Sub
Private Sub Form_Load()
On Error Resume Next
If Command() = "" Then
Form1.Visible = True
SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1 '将封面置为最顶层窗体 Else Form1.Visible = False Form1.Timer1.
Enabled = True
End If
End Sub
Sub Main1()
Dim StartXLSByte, I, J As Long
Dim AppPath, XlsTmpPath As String
Dim myfile As SectionedFile
Dim xlApp As Excel.Application '定义EXCEL类
Dim xlBook As Excel.Workbook '定义工件簿类
Dim xlsheet As Excel.Worksheet '定义工作表类
AppPath = App.Path
XlsTmpPath = GetTempFile() '取得XLS临时文件名（带路径）
If VBA.Right(App.Path, 1) = "\" Then AppPath = VBA.Left(App.Path, VBA.Len(App.Path) - 1)
Open AppPath & "\" & App.EXEName & ".exe" For Binary As #1
ReDim myfile.Files(1)
ReDim myfile.Files(1).Bytes(1 To LOF(1) - EXE_SIZE)
Open XlsTmpPath For Binary As #2
Get #1, EXE_SIZE + 1, myfile.Files(1).Bytes '此处数字要根据EXE实际头文件大小更改设定
Put #2, 1, myfile.Files(1).Bytes
Close #1
Close #2
Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
Set xlBook = xlApp.Workbooks.Open(Filename:=XlsTmpPath, Password:="ldhyob")
'打开EXCEL工作簿,已知该工作簿已加打开口令为ldhyob，若您的工作簿没有口令，则将此参数去掉 '以下星号括起部分代码是往xls里写数据（也可不往工作簿里写数据的 _
方法，而生成txt的方法），作用是保存本exe的绝对路径与临时xls绝对路径，以便于EXE重写更新与临时文件删除 '*****************************************
Set xlsheet = xlBook.Worksheets("temp") '设置活动工作表
xlsheet.Cells(1, 1) = AppPath & "\" & App.EXEName & ".exe" '将该EXE完全路径存在工作表单元格内
xlsheet.Cells(2, 1) = XlsTmpPath '将该EXE本次运行产生XLS临时文件路径存在工作表单元格内 '****************************************
xlApp.Visible = True '设置EXCEL可见
Set xlApp = Nothing '释放xlApp对象
StopTime = 0
Me.Timer1.Enabled = True '启动时钟
End Sub
Private Function GetTempFile() As String '用来产生系统临时文件名
Dim lngRet As Long
Dim strBuffer As String, strTempPath As String
strBuffer = String$(MAX_PATH, 0)
lngRet = GetTempPath(Len(strBuffer), strBuffer)
If lngRet = 0 Then
Exit Function
strTempPath = Left$(strBuffer, lngRet)
strBuffer = String$(MAX_PATH, 0)
lngRet = GetTempFileName(strTempPath, "tmp", 0&, strBuffer)
If lngRet = 0 Then
Exit Function
lngRet = InStr(1, strBuffer, Chr(0))
If lngRet > 0 Then GetTempFile = Left$(strBuffer, lngRet - 1)
Else: GetTempFile = strBuffer
End If
End Function
Private Sub Timer1_Timer()
On Error Resume Next
If Command() <> "" Then
If VBA.Dir(Command()) <> "" Then
Kill Command() '删除本次运行遗留的临时XLS文件
Else: End
End If
Else
StopTime = StopTime + 1 '计时累加
If StopTime = 1 Then
Unload Me: End '2秒后自动关闭退出
End If
End Sub


'在ThisWorkBook代码区头部加入以下代码:
Private Const EXE_SIZE = 81920 '此处数字为前面第7步得到的EXE文件字节数
Private Type FileSection
Bytes() As Byte
End Type
'在Workbook_BeforeClose事件中加入如下代码(对原有的代码可保留)：
Dim myfile As FileSection '定义变量
Dim comc, exec, xlsc As String '定义变量
Application.Visible = False '隐藏EXCEL主窗口
exec = Worksheets("temp").Cells(1, 1).Value
xlsc = Worksheets("temp").Cells(2, 1).Value
comc = exec & " " & xlsc
Open exec For Binary As #1 '打开EXE文件
ReDim myfile.Bytes(1 To EXE_SIZE)
Get #1, 1, myfile.Bytes '取得固有文件头
Close #1
If VBA.Dir(exec) <> "" Then Kill exec
Open exec For Binary As #1 '生成新的EXE文件
Put #1, 1, myfile.Bytes '先写入文件头
Open xlsc For Binary As #2 '打开xls临时文件
ReDim myfile.Bytes(1 To FileLen(xlsc))
Get #2, 1, myfile.Bytes
Put #1, EXE_SIZE + 1, myfile.Bytes '将xls部分追加进EXE
Close #1
Close #2
Application.Quit
Shell comc , vbMinimizedNoFocus '删除临时xls文件
'3、保存文档，退出，关闭EXCEL。（提示：XLS文档不要在open事件中显示起始窗体，在关闭事件中，最好增加询问用户是否保存的语句）

[ 本帖最后由 hank2611 于 2010-12-30 23:21 编辑 ]

oyh499

学习中，谢谢分享

joen168

231楼
Application.Quit Shell
comc , vbMinimizedNoFocus '删除临时xls文件

是否应该为
Application.Quit
Shell comc , vbMinimizedNoFocus '删除临时xls文件

joen168

原帖由 lfy 于 2003-12-13 10:35 发表
前面的第一步我也完成了，现也出现了和楼上朋友一样的问题。
且在做EXCEL部分时，有以下错误。

改成Private Sub Workbook_BeforeClose(Cancel As Boolean)好像没有这个提示，但出现

原帖由 maok124 于 2005-6-29 17:06 发表
excel关闭时提示Open exec For Binary As #1 ''打开EXE文件错误，请帮忙指正，谢谢