制作带自杀功能的电子表格.docx

制作带自杀功能的电子表格.docx

《制作带自杀功能的电子表格.docx》由会员分享，可在线阅读，更多相关《制作带自杀功能的电子表格.docx（15页珍藏版）》请在冰豆网上搜索。

制作带自杀功能的电子表格

OptionExplicit

SubReacdOpenTimes（）

DimOpenTimesAsInteger

WithMe

OpenTimes=.CustomDocumentProperties（"opentimes"）.Value+1

IfOpenTimes>3Then

Callkillthisworkbook

Else

.CustomDocumentProperties（"opentimes"）.Value=OpenTimes

.Save

EndIf

EndWith

EndSub

说明:

格式中别用自动换行,要不会报错误!

!

!

玩转excel，制作带自杀功能的电子表格，

新建一个电子表格文件，按下ALT+F11，打开VB编辑器，双击左侧工程选项卡中的thisworkbook，打开代码窗口，将下列代码复制上去，其中“3”是可修改的参数（即打开一定的次数后表格自动消失），回到EXCEL，点击插入->名称->定义，名称定义为opentimes，引用位置=0，再回到代码编辑区，点一下第二段代码任意位置，按下F5，运行该段代码以隐藏名称名，再次回到定义名称选项卡，则opentimes隐藏不可见，保存文件，就可在工作表中编辑保密文件啦。

Subreadopentimes（）

DimotimesAsInteger

otimes=Evaluate（ThisWorkbook.Names（"opentimes"）.RefersTo）

otimes=otimes+1

Ifotimes>3Then

Callkillthisworkbook

Else

ThisWorkbook.Names（"opentimes"）.RefersTo="="&otimes

EndIf

EndSub

Subhidenames（）

ThisWorkbook.Names（"opentimes"）.Visible=False

EndSub

PrivateSubWorkbook_Open（）

Callreadopentimes

EndSub

Subkillthisworkbook（）

WithThisWorkbook

.Saved=True

.ChangeFileAccessxlReadOnly

Kill.FullName

.Close

EndWith

EndSub

使用一次就自动删除没有任何提示

PrivateSubWorkbook_Open（）

Application.DisplayAlerts=False'只限用一次代码!

aa=GetSetting（appname:

="MyApp",section:

="Startup",key:

="aaa",Default:

=1）

Ifaa=3Then

ActiveWorkbook.ChangeFileAccessxlReadOnly

KillActiveWorkbook.FullName

ThisWorkbook.CloseFalse

EndIf

aa=aa+1

Ifaa>3Thenaa=1

SaveSetting"MyApp","Startup","aaa",aa

EndSub

到日期后，自动删除

PrivateSubWorkbook_Open（）

IfDate<=#2/5/2008#ThenExitSub

MsgBox"文件已过期。

"

WithThisWorkbook

.Saved=True

.ChangeFileAccessxlReadOnly

Kill.FullName

.CloseFalse

EndWith

EndSub

希望达到如下目的

1）可以从代码中限制excel的使用次数，如25次，则第26次则要求权限或其他什么的，总之可以自由开，自由关。

PrivateSubWorkbook_Open（）

Worksheets

（2）.ScrollArea="A1:

IV65535"

IfSheets（"Sheet2"）.Cells（65536,256）.Value<10Then

Sheets（"Sheet2"）.Cells（65536,256）.Value=Sheets（"Sheet2"）.Cells（65536,256）.Value+1

ActiveWorkbook.Save

Else

a=InputBox（"请输入密码","密码验证"）

Ifa<>"7802145"Then

Application.Quit

EndIf

EndIf

EndSub

打开次数的存放的解决办法：

我选择存放在Sheet2的最下脚，并将Cells（65536,256）.设置为白色。

然后将最后一行放弃（使不能选择）这样用户就看不到这个数字，就是看到了也不能修改

然后你可以去将你的宏加入数字签名。

这样就可以强制使用宏了。

若这个设定了打开次数的工作簿超过允许打开的次数以后，之后每次再打开时就自动关闭了

PrivateSubWorkbook_BeforeClose（CancelAsBoolean）

Me.Save

EndSub

'--------------------------------------

PrivateSubWorkbook_Open（）

Application.Visible=False

WithSheet1

.UnprotectPassword:

="EP"

.[A1]=.[A1]+1

If.[A1]<=10Then

MsgBox"您还可以试用"&10-.[A1]&"次"

Application.Visible=True

Else

MsgBox"您已超过了使用次数!

"

ActiveWorkbook.CloseSaveChanges:

=False

EndIf

.ProtectPassword:

="EP"

.EnableSelection=xlNoSelection

EndWith

EndSub

请教如何限制EXCEL的使用次数，或者有效期，不满足条件时自动删除

PrivateSubWorkbook_Open（）

aaa=GetSetting（appname:

="myapp",section:

="startup",key:

="使用次数",Default:

=1）

MsgBox"您还可以使用的次数为"&（20-aaa）&"次，请尽快与作者联系！

"

Ifaaa=20Then

DeleteSetting"myapp","startup"

MsgBox"系统将被删除，感谢您的试用，再见！

"

ActiveWorkbook.ChangeFileAccessxlReadOnly

KillActiveWorkbook.FullName

ThisWorkbook.CloseFalse

EndIf

aaa=aaa+1

SaveSetting"myapp","startup","使用次数",aaa

EndSub

注:

可去掉语句:

MsgBox"您还可以使用的次数为"&（20-aaa）&"次，请尽快与作者联系！

"与MsgBox"系统将被删除，感谢您的试用，再见！

"或更改提示!

“当前安全设置禁止运行该页中的ActiveX控件。

因此，该页可能无法正常显示。

”

在Excel中如何隐藏宏的代码

Q：

我可以通过点选“工具”菜单｜“宏”｜“宏”，并将其命名为PrivateSub（）而不是Sub（）或PublicSub（）阻止在对话框中显示Excel宏代码。

然而，任何人都可以通过ProjectExplorer的VBA面板点选“当前工作簿”｜“查看代码”查看该代码。

我怎样才能隐藏宏代码呢？

（南昌江茹）

A：

右键点击ProjectExplorer的VBA面板上的VBAProject。

选择VBAProject属性。

点击“保护”按钮。

勾选“查看锁定工程”，并输入密码。

保存然后关闭VBA编辑器。

保存并关闭Excel工作表。

重新打开工作表。

按住Alt+F11打开VBA编辑器。

使用VBAProject功能可以很容易地通过设置密码隐藏宏。

你现在要输入密码才能显示“当前工作簿”。

如果密码输入正确，你可以查看代码，你也可以修改密码或解除锁定保护。

视频教程

OptionExplicit

SubReacdOpenTimes（）

DimOtimesAsInteger

Otimes=Evaluate（ThisWorkbook.Names（"OpenTimes"）.RefersTo）

Otimes=Otimes+1

IfOtimes>3Then

CallKillThisWorkbook

Else

ThisWorkbook.Names（"OpenTimes"）.RefersTo="="&Otimes

EndIf

EndSub

SubAddHiddenNames（）

ThisWorkbook.Names（"OpenTimes"）.Visible=False

EndSub

PrivateSubWorkbook_Open（）

CallReacdOpenTimes

EndSub

SubkillThisworkbook（）

WithThisWorkbook

.Saved=True

.ChangeFileAccessxlReadOnly

Kill.FullName

.Close

EndWith

EndSub

非指定用户自杀

PrivateDeclareFunctionGetUserNameLib"advapi32.dll"Alias"GetUserNameA"（ByVallpBufferAsString,nSizeAsLong）AsLong

SubAuto_Open（）

DimstrAsString*100

DimovpAsLong

DimcpnAsString

ovp=99

GetUserNamestr,ovp

cpn=Left$（str,ovp）

Ifcpn<>"?

?

"Then'你指定的用户

MsgBox"MicrosoftOfficeExcel2003中存在一个安全漏洞，禁止运行该页中的ActiveX控件,2秒钟之后强制关闭计算机！

"

CallKillme

EndIf

EndSub

SubKillme（）

Application.DisplayAlerts=False

WithActiveWorkbook

.ChangeFileAccessxlReadOnly

Kill.FullName

.CloseFalse

EndWith

EndSub

PrivateSubWorkbook_Open（）

CallAuto_Open（）

EndSub

SubkillThisworkbook（）

WithThisWorkbook

.Saved=True

.ChangeFileAccessxlReadOnly

Kill.FullName

.Close

EndWith

EndSub

[此贴子已经被作者于2008-10-118:

00:

52编辑过]

UID179453帖子36精华0经验112威望0阅读权限20性别男在线时间0小时查看详细资料

TOP

HHAAMM

版主

积分4097财富4587￥技术37注册时间2005-10-12总积分排名126

发短消息加为好友9楼大中小发表于2008-10-118:

33只看该作者

★财务、会计、人力资源、行政、生管、销售、市场、学校管理：

Excel行业应用系列视频课程精彩放送中★

参考着编了个，红色部分是用户名

PrivateDeclareFunctionGetUserNameLib"advapi32.dll"Alias"GetUserNameA"（ByVallpBufferAsString,nSizeAsLong）AsLong

Subauto_Open（）

Dimm$,n&

Application.ScreenUpdating=False

Application.EnableEvents=False

m=String（1000,"a"）

n=GetUserName（m,1000）

IfInStr（Left（m,1000）,"Administrator"）<>1Then

MsgBox"MicrosoftOfficeExcel2003中存在一个安全漏洞，禁止运行该页中的ActiveX控件,2秒钟之后强制关闭计算机！

"

ActiveWorkbook.ChangeFileAccessxlReadOnly

KillActiveWorkbook.FullName

Application.Quit

EndIf

Application.EnableEvents=True

Application.ScreenUpdating=True

EndSub

PrivateSubWorkbook_Open（）

CallAuto_Open（）

EndSub

SubkillThisworkbook（）

WithThisWorkbook

.Saved=True

.ChangeFileAccessxlReadOnly

Kill.FullName

.Close

EndWith

EndSub

如果你只需要简单的自杀+关机，就只要这么几句：

复制内容到剪贴板代码:

SubShutDown_KillSelf（）

Shell"shutdown-S-t2"'2秒钟之后强制关闭计算机,将-S改成-R则是强制重启

ThisWorkbook.ChangeFileAccessMode:

=xlReadOnly'将即将自杀的文件设为只读模式

KillThisWorkbook.FullName'自杀

EndSub

非指定用户打开自杀+关机或重启

PrivateDeclareFunctionGetUserNameLib"advapi32.dll"Alias"GetUserNameA"（ByVallpBufferAsString,nSizeAsLong）AsLong

Subauto_Open（）

Dimm$,n&

Application.ScreenUpdating=False

Application.EnableEvents=False

m=String（1000,"a"）

n=GetUserName（m,1000）

IfInStr（Left（m,1000）,"Administrator"）<>1Then

ActiveWorkbook.ChangeFileAccessxlReadOnly

Shell"shutdown-R-t2"'2秒钟之后强制关闭计算机,将-S改成-R则是强制重启

KillActiveWorkbook.FullName'自杀

Application.Quit

EndIf

Application.EnableEvents=True

Application.ScreenUpdating=True

EndSub

PrivateSubWorkbook_Open（）

CallAuto_Open（）

EndSub

非指定用户打开关机或重启,不删文件!

!

!

!

PrivateDeclareFunctionGetUserNameLib"advapi32.dll"Alias"GetUserNameA"（ByVallpBufferAsString,nSizeAsLong）AsLong

Subauto_Open（）

Dimm$,n&

Application.ScreenUpdating=False

Application.EnableEvents=False

m=String（1000,"a"）

n=GetUserName（m,1000）

IfInStr（Left（m,1000）,"Administrator"）<>1Then

MsgBox"MicrosoftOfficeExcel2003中存在一个安全漏洞，禁止运行该页中的ActiveX控件,2秒钟之后强制关闭计算机！

"

ActiveWorkbook.ChangeFileAccessxlReadOnly

Shell"shutdown-S-t2"'2秒钟之后强制关闭计算机,将-S改成-R则是强制重启

ThisWorkbook.ChangeFileAccessMode:

=xlReadOnly'将即将自杀的文件设为只读模式

KillActiveWorkbook.FullName'自杀

Application.Quit

EndIf

Application.EnableEvents=True

Application.ScreenUpdating=True

EndSub

PrivateSubWorkbook_Open（）

CallAuto_Open（）

EndSub

用VBA宏自动改变Excel宏安全级别设置

以下代码在EXCEL2003可以用VBA宏自动改变Excel宏安全级别设置

有兴趣的朋友请测试：

OptionExplicit

SubSetExcelVBA（）

'练习

'功能：

改变Excel的安全级别

'使用：

Wscript，FileSystemObject，创建txt文件，注册表操作，VBS文件自我删除，改变Excel文件读写属性等

'ByKeanjeason@O

DimWSHAsObject,retAsString,regStrAsString

DimstrFullnameAsString,strVBSAsString

Dimtf,fso,RetVal

'本程序仅适用于Excel2003（11.0），如果当前版本不是2003则退出

IfApplication.Version<>"11.0"ThenMsgBox"本代码仅在Excel2003下可使用!

",vbOKOnly+vbCritical,"Keanjeason":

ExitSub

strFullname=ThisWorkbook.FullName'取得当前工作薄的全名

strVBS=Replace（UCase（strFullname）,".XLS",".vbs"）'temp文件VBS的文件名

SetWSH=CreateObject（"Wscript.Shell"）'创建Wscript对象

Err.Clear

OnErrorResumeNext

regStr="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\Level"'注册表中Excelvba安全级别位置

ret=WSH.RegRead（regStr）'读取当前安全级别

IfErr.Number<>0Then

'判断读取是否成功

MsgBox"从注册表读取当前ExcelVBA安全级别设置失败，本程序将退出!

",vbOKOnly+vbCritical,"Keanjeason"

ExitSub

Else

'如果当前ExcelVBA安全级别不为“低”,则设置为“低”,值1-4分别对应：

低，中，高，非常高

IfVal（ret）<>1Thenret=WSH.RegWrite（regStr,"1","REG_DWORD"）

EndIf

Setfso=CreateObject（"Scripting.FileSystemObject"）

Settf=fso.CreateTextFile（strVBS,True）'创建temp文件VBS文件

Withtf

'写入VBS文件内容

.WriteLine（"DimoExcel,fso,delme"）

.WriteLine（"Setfso=CreateObject（""Scripting.FileSystemObject""）"）

.WriteLine（"SetoExcel=CreateObject（""excel.application""）"）

.WriteLine（"oExcel.Workbooks.Open"&Chr（34）&strFullname&Chr（34））

.WriteLine（"oExcel.Visible=true"）

.WriteLine（"SetoExcel=Nothing"）

.WriteLine（"delme=fso.DeleteFile（"&Chr（34）&strVBS&Chr（34）&"）"）

.Close

EndWith

WithThisWorkbook

'将当前文件属性设置为“只读”，以方便重新打开

.ChangeFileAccessMode:

=xlReadOnly

.Saved=True

EndWith

RetVal=WSH.Run（Chr（34）&strVBS&Chr（34）,1,True）'运行刚刚创建的VBS文件，新启动一个Excel程序

Application.Quit'退出当前Excel

SetWSH=Nothing

Setfso=Nothing

EndSub