您好:
這個問題較複雜,需要在指定的文件上加載程式碼
另外一個問題是要判斷"指定的文件"上是否已經有Workbook_Open程式碼
附件內的兩個檔案請存放在同一個文件夾內
請直接執行工作表中的 Run 按鈕,在VBE視窗逐行執行會出錯
程式碼如下:
Sub RunPro()
Dim FName As String
Dim wbk As Workbook
Dim Modu, lLine
On Error Resume Next
FName = Application.GetOpenFilename(FileFilter:="Excel File(*.xls),*.xls")
If VarType(FName) = vbBoolean Then
Exit Sub
End If
Set wbk = Workbooks.Open(FName)
Set Modu = wbk.VBProject.VBComponents.Add(1) '加載Module
Modu.Name = "ChineseDragon"
wbk.VBProject.VBComponents.Item(Modu.Name).CodeModule _
.AddFromFile (ThisWorkbook.Path & "\Code.txt")
With wbk.VBProject.VBComponents("ThisWorkbook").CodeModule
lLine = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
If IsEmpty(lLine) Then 'Workbook_Open 不存在時
.InsertLines 1, "Private Sub Workbook_Open()"
.InsertLines 2, "CheckFileDate"
.InsertLines 3, "End Sub"
Else
lLine = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
.InsertLines lLine + 1, "CheckFileDate"
End If
wbk.Save
wbk.Close
MsgBox "使用期限加載完成"
End With
End Sub
中国龙你好: 我下载了你的这个源码,可是点击按纽选择一个excel文件限制日期时,在要限制日期的文件里只在Private Sub Workbook_Open()
End Sub 里增加了CheckFileDate代码,,,,而没有在模块中加入你所说的Code.txt 我的系统是win xp,,,,,,,excel 9.0 请问是什么原因,,难道是我的excel9。0 版本太低不支持??? Set wbk = Workbooks.Open(FName)
Set Modu = wbk.VBProject.VBComponents.Add(1) 'vbext_ct_StdModule加載Module Modu.Name = "ChineseDragon"
wbk.VBProject.VBComponents.Item(Modu.Name).CodeModule _
.AddFromFile (ThisWorkbook.Path & "\Code.txt")
With wbk.VBProject.VBComponents("ThisWorkbook").CodeModule
lLine = .ProcBodyLine("Workbook_Open", vbext_pk_Proc)
|