VBA代码汇总

整理文档很辛苦,赏杯茶钱您下走!

免费阅读已结束,点击下载阅读编辑剩下 ...

阅读已结束,您可以下载文档离线阅读编辑

资源描述

1:打开所有隐藏工作表Sub打开所有隐藏工作表()DimiAsIntegerFori=1ToSheets.CountSheets(i).Visible=TrueNextiEndSub2:循环宏Sub循环()AAA=Range(C2)DimiAsLongDimtimesAsLongtimes=AAA'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647)Fori=1TotimesCall过滤一行IfRange(完成标志)=完成ThenExitFor'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出'IfSheets(传送参数).Range(A&i).Text=完成ThenExitFor'假如某列出现完成内容则退出循环NextiEndSub3:录制宏时调用“停止录制”工具栏Sub录制宏时调用停止录制工具栏()Application.CommandBars(StopRecording).Visible=TrueEndSub4:高级筛选5列不重复数据至指定表Sub高级筛选5列不重复数据至Sheet2()Sheets(Sheet2).Range(A1:E65536)='清除Sheet2的A:D列Range(A1:E65536).AdvancedFilterAction:=xlFilterCopy,CopyToRange:=Sheet2.Range(_A1),Unique:=TrueSheet2.Columns(A:E).SortKey1:=Sheet2.Range(A2),Order1:=xlAscending,Header:=xlGuess,_OrderCustom:=1,MatchCase:=False,Orientation:=xlTopToBottom,SortMethod_:=xlPinYinEndSub5:双击单元执行宏(工作表代码)PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange($A$1)=关闭ThenExitSubSelectCaseTarget.AddressCase$A$4Call宏1Cancel=TrueCase$B$4Call宏2Cancel=TrueCase$C$4Call宏3Cancel=TrueCase$E$4Call宏4Cancel=TrueEndSelectEndSub6:双击指定区域单元执行宏(工作表代码)PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange($A$1)=关闭ThenExitSubIfNotApplication.Intersect(Target,Range(A4:A9,C4:C9))IsNothingThenCall打开隐藏表EndSub7:进入单元执行宏(工作表代码)PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)'以单元格进入代替按钮对象调用宏IfRange($A$1)=关闭ThenExitSubSelectCaseTarget.AddressCase$A$5'单元地址(Target.Address),或命名单元名字(Target.Name)Call宏1Case$B$5Call宏2Case$C$5Call宏3EndSelectEndSub8:进入指定区域单元执行宏(工作表代码)PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange($A$1)=关闭ThenExitSubIfNotApplication.Intersect(Target,Range(A4:A9,C4:C9))IsNothingThenCall打开隐藏表EndSub9:在多个宏中依次循环执行一个(控件按钮代码)PrivateSubCommandButton1_Click()StaticRunMacroAsIntegerSelectCaseRunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0EndSelectEndSub10:在两个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)PrivateSubCommandButton1_Click()WithCommandButton1If.Caption=保护工作表ThenCall保护工作表.Caption=取消工作表保护ExitSubEndIfIf.Caption=取消工作表保护ThenCall取消工作表保护.Caption=保护工作表ExitSubEndIfEndWithEndSub11:在三个宏中依次循环执行一个并相应修改按钮名称(控件按钮代码)OptionExplicitPrivateSubCommandButton1_Click()WithCommandButton1If.Caption=宏1ThenCall宏1.Caption=宏2ExitSubEndIfIf.Caption=宏2ThenCall宏2.Caption=宏3ExitSubEndIfIf.Caption=宏3ThenCall宏3.Caption=宏1ExitSubEndIfEndWithEndSub12:根据A1单元文本隐藏/显示按钮(控件按钮代码)PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange(A1)2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0EndIfEndSubPrivateSubCommandButton1_Click()重排窗口EndSub13:当前单元返回按钮名称(控件按钮代码)PrivateSubCommandButton1_Click()ActiveCell=CommandButton1.CaptionEndSub14:当前单元内容返回到按钮名称(控件按钮代码)PrivateSubCommandButton1_Click()CommandButton1.Caption=ActiveCellEndSub15:奇偶页分别打印Sub奇偶页分别打印()Dimi%,Ps%Ps=ExecuteExcel4Macro(GET.DOCUMENT(50))'总页数MsgBox现在打印奇数页,按确定开始.Fori=1ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiMsgBox现在打印偶数页,按确定开始.Fori=2ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiEndSub16:自动打印多工作表第一页Sub自动打印多工作表第一页()DimshAsIntegerDimxDimyDimsyDimsyzx=InputBox(请输入起始工作表名字:)sy=InputBox(请输入结束工作表名字:)y=Sheets(x).Indexsyz=Sheets(sy).IndexForsh=yTosyzSheets(sh).SelectSheets(sh).PrintOutfrom:=1,To:=1NextshEndSub17:查找A列文本循环插入分页符Sub循环插入分页符()'Selection=Workbooks(临时表).Sheets(表2).Range(A1)调用指定地址内容DimiAsLongDimtimesAsLongtimes=Application.WorksheetFunction.CountIf(Sheet1.Range(a:a),分页)'times代表循环次数,执行前把times赋值即可(不可小于1,不可大于2147483647)Fori=1TotimesCall插入分页符NextiEndSubSub插入分页符()Cells.Find(What:=分页,After:=ActiveCell,LookIn:=xlValues,LookAt:=_xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_.ActivateActiveWindow.SelectedSheets.HPageBreaks.AddBefore:=ActiveCellEndSubSub取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEndSub18:将A列最后数据行以上的所有B列图片大小调整为所在单元大小Sub将A列最后数据行以上的所有B列图片大小调整为所在单元大小()DimPicAsPicture,i&i=[A65536].End(xlUp).RowForEachPicInSheet1.PicturesIfNotApplication.Intersect(Pic.TopLeftCell,Range(B1:B&i))IsNothingThenPic.Top=Pic.TopLeftCell.TopPic.Left=Pic.TopLeftCell.LeftPic.Height=Pic.TopLeftCell.HeightPic.Width=Pic.TopLeftCell.WidthEndIfNextEndSub19:返回光标所在行数Sub返回光标所在行数()x=ActiveCell.RowRange(A1)=xEndSub20:在A1返回当前选中单元格数量Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEndSub21:返回当前工作簿中工作表数量Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBoxtEndSub93:B列录入数据时在A列返回记录时间(工作表代码)PublicSubWorksheet_Change(ByValTargetAsRange)IfTarget.Column=2ThenTarget.Offset(,-1)=NowEndIfEndSub94:当指定区域修改时在其右侧的2个单元返回当前日期和时间(工作表代码)PublicSubWorksheet_Change(ByValTargetAsRange)IfNotApplication.Intersect(Target,[A1:A1000])IsNothingThenIfTarget.Column=1ThenTarget.Offset(,1)=DateTarget.Offset(,2)=TimeEndIfEndIfEndSubPublicSubWorksheet_Change(ByValTargetAsRange)IfNotApplication.Intersect(Target,[A1:A1000])IsNothingThenIfTarget.Column=1ThenTarget.Offset(,1)=Format(Now(),yyyy-mm-dd)Target.Offset(,2)=Format(Now(),h:mm:ss)EndIfEndIfEndSub95:指定单元显示光标位置内容(工作表代码)PrivateSubWorksheet_SelectionChange(ByValTAsRange)Sheets(1).Range(A1)=SelectionEndSub96:每编辑一个单元保存文件PrivateSubWorksheet_Change(ByValTargetAsRange)ThisWorkbook.SaveEndSub97:指定允许编辑区域Sub指定允许编辑区域()ActiveShee

1 / 136
下载文档,编辑使用

©2015-2020 m.777doc.com 三七文档.

备案号:鲁ICP备2024069028号-1 客服联系 QQ:2149211541

×
保存成功