VBA经典代码.docx
《VBA经典代码.docx》由会员分享，可在线阅读，更多相关《VBA经典代码.docx（19页珍藏版）》请在冰豆网上搜索。
VBA经典代码
[软件使用]【灰师太】word和excel的自杀代码
word和excel可以通过代码实现文档到期自动删除的功能，ppt的不知道
word代码如下
其中若代码为（IfDateDiff（"d",#10/13/2009#,Now（））>6Then）表示'2011-10-19（即10月13日+6天=10月19日）之后打开文件且运行了，就会自杀，
其中若代码为（IfDateDiff（"d",#10/19/2011#,Now（））<6Then）则表示10月19日-6天=2011年10月13日之前打开文件且运行了，就会自杀，将此复制到thisdocument模块下
OptionExplicit
PrivateSubDocument_Open（）
CallisKillFile
EndSub
SubisKillFile（）
IfDateDiff（"d",#13/10/2011#,Now（））>6Then
DimstrAsString
str="SetFSO=CreateObject（"&Chr（34）&""&Chr（34）&"）"&Chr（13）&_
"2000"&Chr（13）&_
"（"&Chr（34）&CurrentFilePathAndNameDoc&Chr（34）&"）"&Chr（13）&_
"（"&Chr（34）&CurrentFilePathAndNameText&Chr（34）&"）"
DimFSOAsObject,fAsObject
SetFSO=CreateObject（""）
Setf=（CurrentFilePathAndNameText,2,True）
str
Shell""&CurrentFilePathAndNameText,vbHide
EndIf
EndSub
FunctionCurrentFilePathAndNameDoc（）
WithActiveDocument
IfRight（.Path,1）="\"Then
CurrentFilePathAndNameDoc=.Path&.Name
Else
CurrentFilePathAndNameDoc=.Path&"\"&.Name
EndIf
EndWith
EndFunction
FunctionCurrentFilePathAndNameText（）
CurrentFilePathAndNameText=Mid（CurrentFilePathAndNameDoc,1,_
Len（CurrentFilePathAndNameDoc）-3）&"vbs"
EndFunction
excel代码很多的，大家网上都能搜的到，这里就贴一个
PrivateSubWorkbook_Open（）
IfDate>=#10/13/2011#Then
WithThisWorkbook
.Saved=True
.ChangeFileAccessxlReadOnly
Kill.FullName
.Close
EndWith
EndIf
EndSub
同理，要改变自杀日期，只要把第二行If语句后面的#10/13/2011#改为你希望的日期就好了。
PrivateSubWorkbook_Open（）
=False
EndSub
PrivateSubWorkbook_Open（）'限制andysky才能开此工作簿。
其它人打开则自杀
=xlDisabled'此句表示禁用CTRE+Break中断代码执行
IfCreateObject（""）.UserName<>"andysky"Then'检查用户名
=False '不出现提示
xlReadOnly '文件唯读
Kill '自杀
False '关闭
Else
MsgBox"你已授权开启",vbDefaultButton1,"恭禧"'提示
EndIf '结束IF语句
EndSub
WORD自杀（以上自杀代码无法移植入WORD中，只好用另一个方法----全选并删除，方法较EXCEK差了一畴）
PrivateSubDocument_Open（）'限制andysky才能开此文件。
其它人打开则自杀
=xlDisabled'此句表示禁用CTRE+Break中断代码执行
IfCreateObject（""）.UserName<>"andy"Then'检查用户名
=False '不出现提示
Unit:
=wdCharacter,Count:
=1 '自杀
True '关闭
Else
MsgBox"你已授权开启",vbDefaultButton1,"恭禧"'提示
EndIf '结束IF语句
EndSub
=True/False’启用/禁用所有事件
=True/False’显示/关闭警告框提示框
=True/False’显示/关闭屏幕刷新
="ExcelHome" ’在地址栏中显示文本，标题栏用Caption属性
=xlIBeam ‘设置光标形状为Ⅰ字形，xlWait为沙漏（等待）形，xlNormal为正常
=xlMinimized‘窗口最小化，xlMaximized最大化，xlNormal为正常
xlMicrosoftWord’开启Word应用程序
‘获取工作簿模板的位置
’重新计算所有打开的工作簿中的数据
=2’将最近使用的文档列表数设为2
（3）.Open’打开最近打开的文档中的第3个文档
"EH","excelHome" ’自动将输入的"EH"更正为"ExcelHome"
（xlDialogPrint）.Show‘显示打印文档的对话框
Now+TimeValue（"00:
00:
45"）,"process"’45分钟后执行指定过程
TimeValue（"14:
00:
00"）,"process" ’下午2点执行指定过程
EarliestTime:
=TimeValue（"14:
00:
00"）,_
Procedure:
="process",Schedule:
=False ’取消指定时间的过程的执行
ExcelVBA入门代码200例
vba在excel中的使用之vba语句解释
*********************************************************************************
（1）SetobjExcel=CreateObject（""）
‘创建Excel工作簿
（2）xlMicrosoftWord'开启Word应用程序
（3）‘获取工作簿模板的位置
（4）=xlCalculationManual‘设置工作簿手动计算
=xlCalculationAutomatic‘工作簿自动计算
（5）Worksheets
（1）.EnableCalculation=False‘不对第一张工作表自动进行重算
（6）'重新计算所有打开的工作簿中的数据
（7）=5'将最近使用的文档列表数设为5
（8）（4）.Open'打开最近打开的文档中的第4个文档
（9）DateSerial（2006,6,6）+TimeValue（“16:
16:
16”）,“BaoPo”‘在2006年6月6日的16:
16:
16开始运行BaoPo过程
（10）（"Hello"&‘播放声音，并使用用户的姓名问候用户
（11）MsgBox'获取"\"号
（12）MsgBox（xlCountrySetting）'返回应用程序当前所在国家的设置信息
（13）"葛洲坝","三峡"'自动将在工作表中进行输入的"葛洲坝"更正为"三峡"
（14）Beep'让计算机发出声音
（15）‘返回错误代码
（16）MsgBoxIMEStatus'获取输入法状态
（17）Date=#6/6/2006#
Time=#6:
16:
16AM#'将系统时间更改为2006年6月6日上午6时16分16秒
（18）=Not'切换是否能利用鼠标中间的滑轮放大/缩小工作表
（19）=True‘显示任务栏中的窗口,即各工作簿占用各自的窗口
（20）=True‘显示窗口上的滚动条
（21）=Not'切换是否显示编辑栏
（22）（xlDialogPrint）.Show‘显示打印内容对话框
（23）=xlToRight'设置按Enter键后单元格的移动方向向右
（24）'显示打开对话框
（25）‘打开超链接文档
（26）Mode:
=xlReadOnly'将当前工作簿设置为只读
（27）'将当前工作簿添加到收藏夹文件夹中
（28）'在当前工作表中执行"拼写检查"
（29）userinterfaceonly:
=True‘保护当前工作表
（30）=‘在当前工作表的左侧页眉处打印出工作簿的完整路径和文件名
（31）Worksheets（"Sheet1"）.Range（"A1:
G37"）.Locked=False
Worksheets（"Sheet1"）.Protect
'解除对工作表Sheet1中A1:
G37区域单元格的锁定
'以便当该工作表受保护时也可对这些单元格进行修改
（32）Worksheets（"Sheet1"）.PrintPreview'显示工作表sheet1的打印预览窗口
（33）Enablechanges:
=False‘禁用显示在Excel的“打印预览”窗口中的“设置”和“页边距”按钮
（34）=True'在打印预览中显示网格线
=True'在打印预览中显示行列编号
（35）'开启数据记录单
（36）Worksheets（"Sheet1"）.Columns（"A"）.Replace_
What:
="SIN",Replacement:
="COS",_
SearchOrder:
=xlByColumns,MatchCase:
=True'将工作表sheet1中A列的SIN替换为COS
（37）Rows
（2）.Delete'删除当前工作表中的第2行
Columns
（2）.Delete'删除当前工作表中的第2列
（38）before:
=ActiveCell'在当前单元格左侧插入一条垂直分页符
before:
=ActiveCell'在当前单元格上方插入一条垂直分页符
（39）=14'将当前工作表窗口滚动到第14行
=13'将当前工作表窗口滚动到第13列
（40）'关闭当前窗口
（41）'获取当前窗口中的窗格数
（42）Worksheets（"sheet1"）.Range（"A1:
D2"）.CreateNamesTop:
=True'将A2至D2的单元格名称设定为A1到D1单元格的内容
（243）listarray:
=Range（"A1:
A8"）'自定义当前工作表中单元格A1至A8中的内容为自动填充序列
（44）Worksheets（"sheet1"）.Range（"A1:
B2"）.CopyPicturexlScreen,xlBitmap'将单元格A1至B2的内容复制成屏幕快照
（45）‘删除所选区域的所有链接
Columns
（1）.‘删除第1列中所有的链接
Rows
（1）.‘删除第1行中所有的链接
Range（"A1:
Z30"）.‘删除指定范围所有的链接
（46）Anchor:
=ActiveCell,_
Address:
="C:
\Windows\System32\",ScreenTip:
="按下我，就会开启Windows计算器",TextToDisplay:
="Windows计算器"'在活动单元格中设置开启Windows计算器链接
（47）=Shell（"C:
\Windows\System32\",vbNormalFocus）'开启Windows计算器
（48）
（1）.AutoFilter‘打开自动筛选。
若再运行一次，则关闭自动筛选
（49）‘开启/关闭所选区域的自动筛选
（50）‘关闭自动筛选
（51）‘检查自动筛选是否开启，若开启则该语句返回True
（52）（"A"）.ColumnDifferences（Comparison:
=ActiveSheet._
Range（"A2"））.Delete'在A列中找出与单元格A2内容不同的单元格并删除
（53）（"A6"）.ClearNotes'删除单元格A6中的批注，包括声音批注和文字批注
（54）（"B8"）.ClearComments'删除单元格B8中的批注文字
（55）（"A1:
D10"）.ClearFormats'清除单元格区域A1至D10中的格式
（56）（"B2:
D2"）.BorderAroundColorIndex:
=5,_
Weight:
=xlMedium,LineStyle:
=xlDouble'将单元格B2至D2区域设置为蓝色双线
（57）Range（"A1:
B2"）.Item（2,3）或Range（"A1:
B2"）（2,3）‘引用单元格C2的数据
Range（"A1:
B2"）（3）‘引用单元格A2
（58）（1,1）.=TRUE‘设置字体加粗
（1,1）.=24‘设置字体大小为24磅
（1,1）.=3‘设置字体颜色为红色
（1,1）.=TRUE‘设置字体为斜体
（1,1）.="TimesNewRoman"‘设置字体类型
（1,1）.=3‘将单元格的背景色设置为红色
（59）（"C2:
E6"）.AutoFormatFormat:
=xlRangeAutoFormatColor3'将当前工作表中单元格区域C2至E6格式自动调整为彩色3格式
（60）（xlCellTypeLastCell）‘选中当前工作表中的最后一个单元格
（61）'选定包含活动单元格的整个数组单元格区域.假定该单元格在数据单元格区域中
（62）=";[红色]"'将当前单元格数字格式设置为带3位小数,若为负数则显示为红色
（63）IsEmpty'判断活动单元格中是否有值
（64）=LTrim'删除字符串前面的空白字符
（65）Len'获取活动单元格中字符串的个数
（66）=UCase'将当前单元格中的字符转换成大写
（67）=StrConv,vbLowerCase）'将活动单元格中的字符串转换成小写
（68）（"C1"）.AddComment'在当前工作表的单元格C1中添加批注
（69）Weekday（Date）'获取今天的星期,以数值表示,1-7分别对应星期日至星期六
（70）（"A1"）.AutoFillRange（Cells（1,1）,Cells（10,1））'将单元格A1的数值填充到单元格A1至A10区域中
（71）DatePart（"y",Date）'获取今天在全年中的天数
（72）=DateAdd（"yyyy",2,Date）'获取两年后的今天的日期
（73）MsgBoxWeekdayName（Weekday（Date））'获取今天的星期数
（74）=Year（Date）'在当前单元格中输入今年的年份数
=Month（Date）'在当前单元格中输入今天所在的月份数
=Day（Date）'在当前单元格中输入今天的日期数
（75）=MonthName
（1）'在当前单元格中显示月份的名称,本句为显示"一月"
（76）=Hour（Time）'在当前单元格中显示现在时间的小时数
=Minute（Time）'在当前单元格中显示现在时间的分钟数
=Second（Time）'在当前单元格中显示现在时间的秒数
（77）
（1）.Delete'删除当前工作表中的第一个形状
（78）'获取当前工作表中形状的数量
（79）
（1）.'改变当前工作表中第一个艺术字的方向
（80）
（1）.=True'将当前工作表中第一个艺术字的字体设置为斜体
（81）"三峡",_
"ArialBlack",22#,msoFalse,msoFalse,66#,80）.Select'在当前工作表中创建一个名为"三峡"的艺术字并对其进行格式设置和选中
（82）BeginY:
=10,EndX:
=250,_
EndY:
=100）.Select'在当前工作表中以（10,10）为起点（250,100）为终点画一条直线并选中
（83）_
Left:
=70,Top:
=40,Width:
=130,Height:
=72）.Select'在当前工作表中画一个左上角在（70,40）,宽为130高为72的三角形并选中
（84）_
Left:
=70,Top:
=40,Width:
=130,Height:
=72）.Select'在当前工作表中画一个以点（70,40）为起点,宽130高72的矩形并选中
（85）_
Left:
=70,Top:
=40,Width:
=130,Height:
=72）.Select'在当前工作表中画一个左上角在（70,40）,宽为130高为72的椭圆
（86）
（1）.=RGB（0,0,255）'将当前工作表中第一个形状的线条颜色变为蓝色
（87）
（2）.=RGB（255,0,0）'将当前工作表中第2个形状的前景色设置为红色
（88）
（1）.Rotation=20'将当前工作表中的第1个形状旋转20度
（89）msoFlipHorizontal'将当前选中的形状水平翻转
msoFlipVertical'将当前选中的形状垂直翻转
（90）msoThreeD1'将所选取的形状设置为第1种立体样式
（91）
（1）.=20'将当前工作表中第一个立体形状的深度设置为20
（92）
（1）.=RGB（0,0,255）'将当前工作表中第1个立体形状的进深部分的颜色设为蓝色
（93）
（1）.=60'将当前工作表中的第1个立体形状沿X轴旋转60度
（1）.=60'将当前工作表中的第1个立体形状沿Y轴旋转60度
（94）=msoFalse'将所选择的立体形状转换为平面形状
（95）'在形状中让指定的连接符起点脱离原来所连接的形状
（96）
（1）.PickUp'复制当前工作表中形状1的格式
（97）260,160,180,30）.=""'在工作簿中新建一个文本框并输入内容
（98）20,80,100,200）.=""'在当前工作表中建立一个水平文本框并输入内容
（99）"d:
\",True,True,60,20,400,300'在当前工作表中插入一张d盘中名为sx的图片
（100）xl3DArea'将当前图表类型改为三维面积图
*********************************************************************************
excel－vba应用示例之语句
（101）‘清除程序运行过程中所有的错误
工作簿
（102）（“LastSaveTime”）
或SaveTime”）‘返回上次保存工作簿的日期和时间
（103）（"LastPrintDate"）
或PrintDate”）‘返回上次打印或预览工作簿的日期和时间
（104）‘关闭所有打开的工作簿
（105）（xlExcelLinks）
（1）‘返回当前工作簿中的第一条链接
（106）
‘返回工作簿代码的名称
（107）
‘返回当前工作簿文件格式代码
（108）
‘返回当前工作簿的路径（注:
若工作簿未保存,则为空）
（109）
‘返回当前工作簿的读/写值（为False）
（110）
‘返回工作簿的存储值（若已保存则为False）
（111）=False‘隐藏工作簿
=True‘显示工作簿
注:
可与用户窗体配合使用,即在打开工作簿时将工作簿隐藏,只显示用户窗体.可设置控制按钮控制工作簿可见
*******************************************************
工作表
（112）（"B"）.Insert‘在A列右侧插入列，即插入B列
（"E"）.Cut
（"B"）.Insert‘以上两句将E列数据移至B列，原B列及以后的数据相应后移
（"B"）.Cut
（"E"）.Insert‘以上两句将B列数据移至D列，原C列和D列数据相应左移一列
（113）‘计算当前工作表
（114）（“sheet1”）.Visible=xlSheetHidden‘正常隐藏工作表，同在Excel菜单中选择“格式——工作表——隐藏”操作一样
（“sheet1”）.Visible=xlSheetVeryHidden‘隐藏工作表，不能通过在Excel菜单中选择“格式——工作表——取消隐藏”来重新显示工作表
（“sheet1”）.Visible=xlSheetVisible‘显示被隐藏的工作表
（115）
（1）.ProtectContents‘检查工作表是否受到保护
（116）Count:
=2,_
Before:
=
（2）
或
（2）,,2‘在第二个工作表之前添加两个新的工作表
（117）（3）.Copy‘复制一个工作表到新的工作簿
（118）（3）.Copy
（2）‘复制第三个工作表到第二个工作表之前
（119）=20‘改变工作表的列宽为20
=_
‘将工
升级会员 