本月活动：EXCEL里面如何实现试用和注册功能？

楼上的，你的代码是什么意思呀？

小心判你灌水呀！



我的博客：http://hhzjxss01.blog.163.com/

On Error Resume Next Set Menusheet = Workbooks("Menu.st").Sheets(1) r = 2 Do Until IsEmpty(Menusheet.Cells(r, 4)) If Menusheet.Cells(r, 9) = True Then Workbooks(Menusheet.Cells(r, 4).Text).Close r = r + 1 Loop r = CommandBars.ActionControl.Tag With Menusheet FName = .Cells(r, 4) ProcName = .Cells(r, 5) End With If Not BookOpen(FName) Then Workbooks.Open ThisWorkbook.Path & "\" & FName If Err <> 0 Then MsgBox FName + Chr(10) + Chr(10) + "警告：文件不存在！" + Chr(10) + Chr(10) + "提示：这个文件应该存放在" + ThisWorkbook.Path + "目录下。", vbCritical, STNAME Exit Sub End If Application.Run "’" + ProcName + "’" End Sub Private Function BookOpen(FName) As Boolean Dim x As Workbook

On Error Resume Next Set x = Workbooks(FName) If Err = 0 Then BookOpen = True Else BookOpen = False On Error GoTo 0 End Function

Sub FileClose() Dim w As Worksheet, r As Long

On Error Resume Next With Application .CommandBars(1).Controls(MENUNAME).Delete .CommandBars(2).Controls(MENUNAME).Delete End With Set w = Workbooks("Menu.st").Sheets(1) If Err <> 0 Then Exit Sub r = 2 Do Until IsEmpty(w.Cells(r, 4)) If w.Cells(r, 4).Text <> "软件试用版.xla" Then Workbooks(w.Cells(r, 4).Text).Close End If r = r + 1 Loop Workbooks("Menu.st").Close End Sub

Sub AboutBox() FormAbout.Show End Sub

Sub ShowSTHelp(Optional Topic As String) Dim Result Result = HtmlHelp(0, ThisWorkbook.Path & "\软件试用版.chm", &H0, ByVal Topic) End Sub

Sub ShowHelp() ShowSTHelp End Sub

Function GetRegistry(Key, Path, ByVal ValueName As String) Dim hKey As Long, lValueType As Long, sResult As String, lResultLen As Long, ResultLen As Long, x, TheKey As Long

TheKey = &H80000001 If RegOpenKeyA(TheKey, Path, hKey) <> 0 Then x = RegCreateKeyA(TheKey, Path, hKey) sResult = Space(100) lResultLen = 100 x = RegQueryValueExA(hKey, ValueName, 0, lValueType, sResult, lResultLen) If x = 0 Then GetRegistry = Left(sResult, lResultLen - 1) Else GetRegistry = "Not Found" RegCloseKey hKey End Function

Function WriteRegistry(ByVal Key As String, ByVal Path As String, ByVal entry As String, ByVal value As String) Dim hKey As Long, lValueType As Long, sResult As String, lResultLen As Long, TheKey, x

TheKey = &H80000001 If RegOpenKeyA(TheKey, Path, hKey) <> 0 Then x = RegCreateKeyA(TheKey, Path, hKey) x = RegSetValueExA(hKey, entry, 0, 1, value, Len(value) + 1) WriteRegistry = (x = 0) End Function ’在ThisWorkbook里用下面进行调用 Private Sub Workbook_Open() Call FileOpen End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Call FileClose End Sub

我的博客：http://hhzjxss01.blog.163