首页 EXCELVBA编程的常用代码

EXCELVBA编程的常用代码

举报
开通vip

EXCELVBA编程的常用代码RevisedbyChenZhenin2021EXCELVBA编程的常用代码ExcelVBA编程的常用代码用过VB的人都应该知道如何声明变量,在VBA中声明变量和VB中是完全一样的!使用Dim语句Dimaasinteger'声明a为整型变量Dima'声明a为变体变量Dimaasstring'声明a为字符串变量Dimaascurrency,bascurrency,cascurrency'声明a,b,c为货币变量......声明变量可以是:Byte、Boolean、Integer、Long、Currency、Singl...

EXCELVBA编程的常用代码
RevisedbyChenZhenin2021EXCELVBA编程的常用代码ExcelVBA编程的常用代码用过VB的人都应该知道如何声明变量,在VBA中声明变量和VB中是完全一样的!使用Dim语句Dimaasinteger'声明a为整型变量Dima'声明a为变体变量Dimaasstring'声明a为字符串变量Dimaascurrency,bascurrency,cascurrency'声明a,b,c为货币变量......声明变量可以是:Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal(当前不支持)、Date、String(只限变长字符串)、String*length(定长字符串)、Object、Variant、用户定义类型或对象类型。强制声明变量OptionExplicit说明:该语句必在任何过程之前出现在模块中。声明常数用来代替文字值。Const'常数的默认状态是Private。ConstMy=456'声明Public常数。PublicConstMyString="HELP"'声明PrivateInteger常数。PrivateConstMyIntAsInteger=5'在同一行里声明多个常数。ConstMyStr="Hello",MyDoubleAsDouble=选择当前单元格所在区域在EXCEL97中,有一个十分好的功能,他就是把鼠标放置在一个有效数据单元格中,执行该段代码,你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。返回当前单元格中数据删除前后空格后的值submy_trimmsgboxTrimendsub单元格位移submy_offset(0,1).Select'当前单元格向左移动一格(0,-1).Select'当前单元格向右移动一格(1,0).Select'当前单元格向下移动一格(-1,0).Select'当前单元格向上移动一格endsub如果上述程序产生错误那是因为单元格不能移动,为了解除上述错误,我们可以往submy_offset之下加一段代码onerrorresumenext注意以下代码都不再添加sub“代码名称”和endsub请自己添加!给当前单元格赋值="你好!!!"给指定单元格赋值例如:A1单元格内容设为"HELLO"Range("a1").value="hello"又如:你现在的工作簿在sheet1上,你要往sheet2的A1单元格中插入"HELLO"1.sheets("sheet2").selectrange("a1").value="hello"或2.Sheets("sheet1").Range("a1").Value="hello"说明:被选中,然后在将“HELLO"赋到A1单元格中。不必被选中,即可“HELLO"赋到sheet2的A1单元格中。隐藏工作表'隐藏SHEET1这张工作表  sheets("sheet1").Visible=False'显示SHEET1这张工作表  sheets("sheet1").Visible=True打印预览有时候我们想把所有的EXCEL中的SHEET都打印预览,请使用该段代码,它将在你现有的工作簿中循环,直到最后一个工作簿结束循环预览。DimmyAsWorksheetForEachmyInWorksheetsNextmy得到当前单元格的地址msgbox得到当前日期及时间msgboxdate&chr(13)&time保护工作簿取消保护工作簿给活动工作表改名为"liu"="liu"打开一个应用程序AppActivate(Shell("C:/WINDOWS/"))增加一个工作表删除活动工作表打开一个工作簿文件FileName:="C:/MyDocuments/"关闭活动窗口单元格格式选定单元格左对齐=xlLeft选定单元格居中=xlCenter选定单元格右对齐=xlRight选定单元格为百分号风格="Percent"选定单元格字体为粗体选定单元格字体为斜体选定单元格字体为宋体20号字With.Name="宋体".Size=20EndWithWith语句With对象.描述EndWith清除单元格'删除所有文字、批注、格式返回选定区域的行数返回选返回选定区域的地址忽略所有的错误ONERRORRESUMENEXT遇错跳转onerrorgotoerr_handle'中间的其他代码err_handle:'标签'跳转后的代码删除一个文件kill"c:/"定制自己的状态栏="现在时刻:"&Time恢复自己的状态栏=false用代码执行一个宏macro:="text"滚动窗口到a1的位置=1=1定制系统日期DimMyDate,MyDayMyDate=#12/12/69#MyDay=Day(MyDate)返回当天的时间DimMyDate,MyYearMyDate=DateMyYear=Year(MyDate)MsgBoxMyYearinputbox<输入框>XX=InputBox("Enternumberofmonthstoadd")得到一个文件名DimkkAsStringkk=("EXCEL(*.XLS),*.XLS",Title:="提示:请打开一个EXCEL文件:")msgboxkk打开zoom对话框(xlDialogZoom).Show激活字体对话框(xlDialogActiveCellFont).Show打开另存对话框DimkkAsStringkk=("excel(*.xls),*.xls")kk工作簿(Workbook)基本操作应用示例(一)Workbook对象代表工作簿,而Workbooks集合则包含了当前所有的工作簿。下面对Workbook对象的重要的方法和属性以及其它一些可能涉及到的方法和属性进行示例介绍,同时,后面的示例也深入介绍了一些工作簿对象操作的方法和技巧。示例03-01:创建工作簿(Add方法)[示例03-01-01]SubCreateNewWorkbook1() MsgBox"将创建一个新工作簿." EndSub[示例03-01-02]SubCreateNewWorkbook2() DimwbAsWorkbook DimwsAsWorksheet DimiAsLong MsgBox"将创建一个新工作簿,并预设工作表格式." Setwb= Setws=(1) ="产品汇总表" (1,1)="序号" (1,2)="产品名称" (1,3)="产品数量" Fori=2To10   (i,1)=i-1 NextiEndSub示例03-02:添加并保存新工作簿SubAddSaveAsNewWorkbook() DimWkAsWorkbook SetWk= =False Filename:="D:/"EndSub示例说明:本示例使用了Add方法和SaveAs方法,添加一个新工作簿并将该工作簿以文件名保存在D盘中。其中,语句=False表示禁止弹出警告对话框。示例03-03:打开工作簿(Open方法)[示例03-03-01]SubopenWorkbook1()   "<需打开文件的路径>/<文件名>"EndSub示例说明:代码中的<>里的内容需用所需打开的文件的路径及文件名代替。Open方法共有15个参数,其中参数FileName为必需的参数,其余参数可选。[示例03-03-02]SubopenWorkbook2() DimfnameAsString MsgBox"将D盘中的<测试.xls>工作簿以只读方式打开" fname="D:/测试.xls" Filename:=fname,ReadOnly:=TrueEndSub示例03-04:将文本文件导入工作簿中(OpenText方法)SubTextToWorkbook() '本示例打开某文本文件并将制表符作为分隔符对此文件进行分列处理转换成为工作表 Filename:="<文本文件所在的路径>/<文本文件名>",_     DataType:=xlDelimited,Tab:=TrueEndSub示例说明:代码中的<>里的内容需用所载入的文本文件所在路径及文件名代替。OpenText方法的作用是导入一个文本文件,并将其作为包含单个工作表的工作簿进行分列处理,然后在此工作表中放入经过分列处理的文本文件数据。该方法共有18个参数,其中参数FileName为必需的参数,其余参数可选。示例03-05:保存工作簿(Save方法)[示例03-05-01]SubSaveWorkbook() MsgBox"保存当前工作簿." EndSub[示例03-05-02]SubSaveAllWorkbook1() DimwbAsWorkbook MsgBox"保存所有打开的工作簿后退出Excel." ForEachwbIn    Nextwb EndSub[示例03-05-03]SubSaveAllWorkbook2() DimwbAsWorkbook ForEachwbInWorkbooks   If<>""Then NextwbEndSub示例说明:本示例保存原来已存在且已打开的工作簿。示例03-06:保存工作簿(SaveAs方法)[示例03-06-01]SubSaveWorkbook1() MsgBox"将工作簿以指定名保存在默认文件夹中." "<工作簿名>.xls"EndSub示例说明:SaveAs方法相当于“另存为……”命令,以指定名称保存工作簿。该方法有12个参数,均为可选参数。如果未指定保存的路径,那么将在默认文件夹中保存该工作簿。如果文件夹中该工作簿名已存在,则提示是否替换原工作簿。[示例03-06-02]SubSaveWorkbook2() DimoldNameAsString,newNameAsString DimfolderNameAsString,fnameAsString oldName= newName="new"&oldName MsgBox"将<"&oldName&">以<"&newName&">的名称保存" folderName= fname=folderName&"/"&newName fnameEndSub示例说明:本示例将当前工作簿以一个新名(即new加原名)保存在默认文件夹中。[示例03-06-03]SubCreateBak1() MsgBox"保存工作簿并建立备份工作簿" CreateBackup:=TrueEndSub示例说明:本示例将在当前文件夹中建立工作簿的备份。[示例03-06-04]SubCreateBak2() MsgBox"保存工作簿时,若已建立了备份,则将出现包含True的信息框,否则出现False." MsgBoxEndSub示例03-07:取得当前打开的工作簿数(Count属性)SubWorkbookNum() MsgBox"当前已打开的工作簿数为:"&Chr(10)&EndSub示例03-08:激活工作簿(Activate方法)[示例03-08-01]SubActivateWorkbook1() Workbooks("<工作簿名>").ActivateEndSub示例说明:Activate方法激活一个工作簿,使该工作簿为当前工作簿。[示例03-08-02]SubActivateWorkbook2() DimnAsLong,iAsLong DimbAsString MsgBox"依次激活已经打开的工作簿" n= Fori=1Ton   Workbooks(i).Activate   b=MsgBox("第"&i&"个工作簿被激活,还要继续吗",vbYesNo)   Ifb=vbNoThenExitSub   Ifi=nThenMsgBox"最后一个工作簿已被激活." NextiEndSub示例03-09:保护工作簿(Protect方法)SubProtectWorkbook() MsgBox"保护工作簿结构,密码为123" Password:="123",Structure:=True MsgBox"保护工作簿窗口,密码为123" Password:="123",Windows:=True MsgBox"保护工作簿结构和窗口,密码为123" Password:="123",Structure:=True,Windows:=TrueEndSub示例说明:使用Protect方法来保护工作簿,带有三个可选参数,参数Password指明保护工作簿密码,要解除工作簿保护应输入此密码;参数Structure设置为True则保护工作簿结构,此时不能对工作簿中的工作表进行插入、复制、删除等操作;参数Windows设置为True则保护工作簿窗口,此时该工作簿右上角的最小化、最大化和关闭按钮消失。示例03-10:解除工作簿保护(UnProtect方法)SubUnprotectWorkbook() MsgBox"取消工作簿保护" "123"EndSub示例03-11:工作簿的一些通用属性示例SubtestGeneralWorkbookInfo() MsgBox"本工作簿的名称为"& MsgBox"本工作簿带完整路径的名称为"& MsgBox"本工作簿对象的代码名为"& MsgBox"本工作簿的路径为"& IfThen   MsgBox"本工作簿已经是以只读方式打开" Else   MsgBox"本工作簿可读写." EndIf IfThen   MsgBox"本工作簿已保存." Else   MsgBox"本工作簿需要保存." EndIfEndSub示例03-12:访问工作簿的内置属性(BuiltinDocumentProperties属性)[示例03-12-01]SubShowWorkbookProperties() DimSaveTimeAsString OnErrorResumeNext SaveTime=("LastSaveTime").Value IfSaveTime=""Then   MsgBox&"工作簿未保存." Else   MsgBox"本工作簿已于"&SaveTime&"保存",, EndIfEndSub示例说明:在Excel中选择菜单“文件——属性”命令时将会显示一个“属性”对话框,该对话框中包含了当前工作簿的有关信息,可以在VBA中使用BuiltinDocumentProperties属性访问工作簿的属性。上述示例代码将显示当前工作簿保存时的日期和时间。[示例03-12-02]SublistWorkbookProperties() OnErrorResumeNext '在名为"工作簿属性"的工作表中添加信息,若该工作表不存在,则新建一个工作表 Worksheets("工作簿属性").Activate If<>0Then   after:=Worksheets   ="工作簿属性" Else    EndIf OnErrorGoTo0 ListPropertiesEndSub‘-----------------------SubListProperties() DimiAsLong Cells(1,1)="名称" Cells(1,2)="类型" Cells(1,3)="值" Range("A1:C1").=True WithActiveWorkbook   Fori=1To.     With.BuiltinDocumentProperties(i)       Cells(i+1,1)=.Name       SelectCase.Type         CasemsoPropertyTypeBoolean           Cells(i+1,2)="Boolean"         CasemsoPropertyTypeDate           Cells(i+1,2)="Date"         CasemsoPropertyTypeFloat           Cells(i+1,2)="Float"         CasemsoPropertyTypeNumber           Cells(i+1,2)="Number"         CasemsoPropertyTypeString           Cells(i+1,2)="string"       EndSelect       OnErrorResumeNext       Cells(i+1,3)=.Value       OnErrorGoTo0     EndWith   Nexti EndWith Range("A:C").EndSub示例说明:本示例代码在“工作簿属性”工作表中列出了当前工作簿中的所有内置属性。示例03-13:测试工作簿中是否包含指定工作表(Sheets属性)SubtestSheetExists() MsgBox"测试工作簿中是否存在指定名称的工作表" DimbAsBoolean b=SheetExists("<指定的工作表名>") Ifb=TrueThen   MsgBox"该工作表存在于工作簿中." Else   MsgBox"工作簿中没有这个工作表." EndIfEndSub‘-----------------------PrivateFunctionSheetExists(sname)AsBoolean DimxAsObject OnErrorResumeNext Setx=(sname) IfErr=0Then   SheetExists=True Else   SheetExists=False EndIfEndFunction示例03-14:对未打开的工作簿进行重命名(Name方法)Subrename() Name"<工作簿路径>/<旧名称>.xls"As"<工作簿路径>/<新名称>.xls"EndSub示例说明:代码中<>中的内容为需要重命名的工作簿所在路径及新旧名称。该方法只是对未打开的文件进行重命名,如果该文件已经打开,使用该方法会提示错误。示例03-15:设置数字精度(PrecisionAsDisplayed属性)SubSetPrecision() DimpValue MsgBox"在当前单元格中输入1/3,并将结果算至小数点后两位" =1/3 ="" pValue=*3 MsgBox"当前单元格中的数字乘以3等于:"&pValue MsgBox"然后,将数值分类设置为[数值],即单元格中显示的精度" =True pValue=*3 MsgBox"此时,当前单元格中的数字乘以3等于:"&pValue&"而不是1" =FalseEndSub示例说明:PrecisionAsDisplayed属性的值设置为True,则表明采用单元格中所显示的数值进行计算。示例03-16:删除自定义数字格式(DeleteNumberFormat方法)SubDeleteNumberFormat() MsgBox"从当前工作簿中删除000-00-0000的数字格式" ("000-00-0000")EndSub示例说明:DeleteNumberFormat方法将从指定的工作簿中删除自定义的数字格式。示例03-17:控制工作簿中图形显示(DisplatyDrawingObjects属性)SubtestDraw() MsgBox"隐藏当前工作簿中的所有图形" =xlHide MsgBox"仅显示当前工作簿中所有图形的占位符" =xlPlaceholders MsgBox"显示当前工作簿中的所有图形" =xlDisplayShapesEndSub示例说明:本属性作用的对象包括图表和形状。在应用本示例前,应保证工作簿中有图表或形状,以察看效果。示例03-18:指定名称(Names属性)SubtestNames() MsgBox"将当前工作簿中工作表Sheet1内单元格A1命名为说明:对于Workbook对象而言,Names属性返回的集合代表工作簿中的所有名称。示例03-19:检查工作簿的自动恢复功能(EnableAutoRecover属性)SubUseAutoRecover() '检查是否工作簿自动恢复功能开启,如果没有则开启该功能 If=FalseThen   =True   MsgBox"刚开启自动恢复功能." Else   MsgBox"自动恢复功能已开启." EndIfEndSub示例03-20:设置工作簿密码(Password属性)SubUsePassword() DimwbAsWorkbook Setwb= =InputBox("请输入密码:") EndSub示例说明:Password属性返回或设置工作簿密码,在打开工作簿时必须输入密码。本示例代码运行后,提示设置密码,然后关闭工作簿;再次打开工作簿时, 要求 对教师党员的评价套管和固井爆破片与爆破装置仓库管理基本要求三甲医院都需要复审吗 输入密码。示例03-21:返回工作簿用户状态信息户名"   .Cells(Row,2)="日期和时间"   .Cells(Row,3)="使用方式"   ForRow=1ToUBound(Users,1)     .Cells(Row+1,1)=Users(Row,1)     .Cells(Row+1,2)=Users(Row,2)     SelectCaseUsers(Row,3)       Case1         .Cells(Row+1,3).Value="个人工作簿"       Case2         .Cells(Row+1,3).Value="共享工作簿"     EndSelect   Next EndWith Range("A:C").EndSub示例说明:示例代码运行后,将创建一个新工作簿并带有用户使用当前工作簿的信息,即用户名、打开的日期和时间及工作簿使用方式。示例03-22:检查工作簿是否有密码保护(HasPassword属性)SubIsPassword() If=TrueThen   MsgBox"本工作簿有密码保护,请在管理员处获取密码." Else   MsgBox"本工作簿无密码保护,您可以自由编辑." EndIfEndSub示例03-23:决定列表边框是否可见(InactiveListBorderVisible属性)SubHideListBorders() MsgBox"隐藏当前工作簿中所有非活动列表的边框." =FalseEndSub示例03-24:关闭工作簿[示例03-24-01]SubCloseWorkbook1()Msgbox“不保存所作的改变而关闭本工作簿”False‘或SaveChanges:=False‘或=TrueEndsub[示例03-24-02]SubCloseWorkbook2()Msgbox“保存所作的改变并关闭本工作簿”TrueEndsub[示例03-24-03]SubCloseWorkbook3()Msgbox“关闭本工作簿。如果工作簿已发生变化,则弹出是否保存更改的对话框。”TrueEndsub[示例03-24-04]关闭并保存所有工作簿SubCloseAllWorkbooks() DimBookAsWorkbook ForEachBookInWorkbooksIf<>Thensavechanges:=TrueEndIfNextBooksavechanges:=TrueEndSub[示例03-24-05]关闭工作簿并将它彻底删除SubKillMe()WithThisWorkbook.Saved=True.ChangeFileAccessMode:=xlReadOnlyKill.FullName.CloseFalseEndWithEndSub[示例03-24-06]关闭所有工作簿,若工作簿已改变则弹出是否保存变化的对话框SubcloseAllWorkbook() MsgBox"关闭当前所打开的所有工作簿" EndSub 工作簿(Workbook)基本操作应用示例(二)<其它一些有关操作工作簿的示例>示例03-25:创建新的工作簿SubtestNewWorkbook()MsgBox"创建一个带有10个工作表的新工作簿"DimwbasWorkbookSetwb=NewWorkbook(10)EndSub‘-----------------------FunctionNewWorkbook(wsCountAsInteger)AsWorkbook'创建带有由变量wsCount提定数量工作表的工作簿,工作表数在1至255之间DimOriginalWorksheetCountAsLong SetNewWorkbook=Nothing IfwsCount<1OrwsCount>255ThenExitFunction OriginalWorksheetCount= =wsCountSetNewWorkbook= =OriginalWorksheetCountEndFunction示例说明:自定义函数NewWorkbook可以创建最多带有255个工作表的工作簿。本测试示例创建一个带有10个工作表的新工作簿。示例03-26:判断工作簿是否存在SubtestFileExists() MsgBox"如果文件不存在则用信息框说明,否则打开该文件." IfNotFileExists("C:/文件夹/子文件夹/文件.xls")Then   MsgBox"这个工作簿不存在!" Else   "C:/文件夹/子文件夹/文件.xls" EndIfEndSub‘-----------------------FunctionFileExists(FullFileNameAsString)AsBoolean '如果工作簿存在,则返回True FileExists=Len(Dir(FullFileName))>0EndFunction示例说明:本示例使用自定义函数FileExists判断工作簿是否存在,若该工作簿已存在,则打开它。代码中,“C:/文件夹/子文件夹/文件.xls”代表工作簿所在的文件夹名、子文件夹名和工作簿文件名。示例03-27:判断工作簿是否已打开[示例03-27-01]SubtestWorkbookOpen() MsgBox"如果工作簿未打开,则打开该工作簿." IfNotWorkbookOpen("工作簿名.xls")Then   "工作簿名.xls" EndIfEndSub‘-----------------------FunctionWorkbookOpen(WorkBookNameAsString)AsBoolean '如果该工作簿已打开则返回真 WorkbookOpen=False OnErrorGoToWorkBookNotOpen IfLen(WorkBookName).Name)>0Then   WorkbookOpen=True   MsgBox"该工作簿已打开"   ExitFunction EndIfWorkBookNotOpen:EndFunction示例说明:本示例中的函数WorkbookOpen用来判断工作簿是否打开。代码中,“工作簿名.xls”代表所要打开的工作簿名称。[示例03-27-02]SubtestWookbookIFOpen() DimwbAsString DimbwbAsBoolean wb="<要判断的工作簿名称>" bwb=WorkbookIsOpen(wb) Ifbwb=TrueThen   MsgBox"工作簿"&wb&"已打开." Else   MsgBox"工作簿"&wb&"未打开." EndIfEndSub‘-----------------------PrivateFunctionWorkbookIsOpen(wbname)AsBoolean DimxAsWorkbook OnErrorResumeNext Setx=Workbooks(wbname) IfErr=0Then   WorkbookIsOpen=True Else   WorkbookIsOpen=False EndIfEndFunction示例03-28:备份工作簿[示例03-28-01]用与活动工作簿相同的名字但后缀名为.bak备份工作簿SubSaveWorkbookBackup() DimawbAsWorkbook,BackupFileNameAsString,iAsInteger,OKAsBoolean IfTypeName(ActiveWorkbook)="Nothing"ThenExitSub Setawb=ActiveWorkbook If=""Then   (xlDialogSaveAs).Show Else   BackupFileName=   i=0   WhileInStr(i+1,BackupFileName,".")>0     i=InStr(i+1,BackupFileName,".")   Wend   Ifi>0ThenBackupFileName=Left(BackupFileName,i-1)   BackupFileName=BackupFileName&".bak"   OK=False   OnErrorGoToNotAbleToSave   Withawb     ="正在保存工作簿..."     .Save     ="正在备份工作簿..."     .SaveCopyAsBackupFileName     OK=True   EndWith EndIfNotAbleToSave: Setawb=Nothing =False IfNotOKThen   MsgBox"备份工作簿未保存!",vbExclamation, EndIfEndSub示例说明:在当前工作簿中运行本示例代码后,将以与工作簿相同的名称但后缀名为.bak备份工作簿,且该备份与当前工作簿在同一文件夹中。其中,使用了工作簿的FullName属性和SaveCopyAs方法。[示例03-28-02]保存当前工作簿的副本到其它位置备份工作簿SubSaveWorkbookBackupToFloppyD() DimawbAsWorkbook,BackupFileNameAsString,iAsInteger,OKAsBoolean IfTypeName(ActiveWorkbook)="Nothing"ThenExitSub Setawb=ActiveWorkbook If=""Then   (xlDialogSaveAs).Show Else   BackupFileName=   OK=False   OnErrorGoToNotAbleToSave   IfDir("D:/"&BackupFileName)<>""Then     Kill"D:/"&BackupFileName   EndIf   Withawb     ="正在保存工作簿..."     .Save     ="正在备份工作簿..."     .SaveCopyAs"D:/"&BackupFileName     OK=True   EndWith EndIfNotAbleToSave: Setawb=Nothing =False IfNotOKThen   MsgBox"备份工作簿未保存!",vbExclamation, EndIfEndSub示例说明:本程序将把当前工作簿进行复制并以与当前工作簿相同的名称保存在D盘中。其中,使用了Kill方法来删除已存在的工作簿。示例03-29:从已关闭的工作簿中取值[示例03-29-01]SubtestGetValuesFromClosedWorkbook() GetValuesFromAClosedWorkbook"C:","","Sheet1","A1:G20"EndSub‘-----------------------SubGetValuesFromAClosedWorkbook(fPathAsString,_           fNameAsString,sName,cellRangeAsString) With(cellRange)   .FormulaArray="='"&fPath&"/["&fName&"]"_                   &sName&"'!"&cellRange   .Value=.Value EndWithEndSub示例说明:本示例包含一个子过程GetValuesFromAClosedWorkbook,用来从已关闭的工作簿中获取数据,主过程testGetValuesFromClosedWorkbook用来传递参数。本示例表示从C盘根目录下的工作簿的工作表Sheet1中的A1:G20单元格区域内获取数据,并将其复制到当前工作表相应单元格区域中。[示例03-29-02]SubReadDataFromAllWorkbooksInFolder() DimFolderNameAsString,wbNameAsString,rAsLong,cValueAsVariant DimwbList()AsString,wbCountAsInteger,iAsInteger FolderName="C:/文件夹名" '创建文件夹中工作簿列表 wbCount=0 wbName=Dir(FolderName&"/"&"*.xls") WhilewbName<>""   wbCount=wbCount+1   ReDimPreservewbList(1TowbCount)   wbList(wbCount)=wbName   wbName=Dir Wend IfwbCount=0ThenExitSub '从每个工作簿中获取数据 r=0  Fori=1TowbCount   r=r+1   cValue=GetInfoFromClosedFile(FolderName,wbList(i),"Sheet1","A1")   Cells(r,1).Formula=wbList(i)   Cells(r,2).Formula=cValue NextiEndSub‘-----------------------PrivateFunctionGetInfoFromClosedFile(ByValwbPathAsString,_   wbNameAsString,wsNameAsString,cellRefAsString)AsVariant DimargAsString GetInfoFromClosedFile="" IfRight(wbPath,1)<>"/"ThenwbPath=wbPath&"/" IfDir(wbPath&"/"&wbName)=""ThenExitFunction arg="'"&wbPath&"["&wbName&"]"&_       wsName&"'!"&Range(cellRef).Address(True,True,xlR1C1) OnErrorResumeNext GetInfoFromClosedFile=ExecuteExcel4Macro(arg)EndFunction示例说明:本示例将读取一个文件夹内所有工作簿中工作表Sheet1上单元格A1中的值到一个新工作簿中。代码中,“C:/文件夹名”代表工作簿所在的文件夹名。[示例03-29-03]SubGetDataFromClosedWorkbook() DimwbAsWorkbook =False '以只读方式打开工作簿 Setwb=("C:/文件夹名/文件.xls",True,True) With("工作表名") '从工作簿中读取数据   .Range("A10").Formula=("源工作表名").Range("A10").Formula   .Range("A11").Formula=("源工作表名").Range("A20").Formula   .Range("A12").Formula=("源工作表名").Range("A30").Formula   .Range("A13").Formula=("源工作表名").Range("A40").Formula EndWith False'关闭打开的源数据工作簿且不保存任何变化 Setwb=Nothing'释放内存 =TrueEndSub示例说明:在运行程序时,打开所要获取数据的工作簿,当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False,将看不出源数据工作簿是否被打开过。本程序代码中,“C:/文件夹名/文件.xls”、"源工作表名"代表工作簿所在的文件夹和工作簿文件名 VBA语句集前面已经推出了两辑VBA语句集,共有200句VBA常用代码及代码功能的简要解释。根据前阶段在学习VBA过程中总结归纳的成果,特汇编了VBA语句集第3辑,供大家在学习VBA编程时参考。其实,您可以在VBE编辑器中将这些语句进行测试,以体验其作用或效果。VBA语句集的特点是,一句VBA代码,后面配有代码功能简要的说明或解释。每辑100句,尽可能收录所有在程序中所要用到的代码。创建Excel工作簿(202)xlMicrosoftWord'开启Word应用程序(203)‘获取工作簿模板的位置(204)=xlCalculationManual‘设置工作簿手动计算  =xlCalculationAutomatic‘工作簿自动计算(205)Worksheets(1).EnableCalculation=False‘不对第一张工作表自动进行重算(206)'重新计算所有打开的工作簿中的数据设为5(208)(4).Open'打开最近打开的文档中的第4个文档(209)DateSerial(2006,6,6)+TimeValue(“16:16:16”),“BaoPo”‘在2006年6月6日的16:16:16开始运行BaoPo过程户的姓名问候用户(211)MsgBox'获取"/"号(212)MsgBox(xlCountrySetting)'返回应用程序当前所在国家的设置信息坝","三峡"'自动将在工作表中进行输入的"葛洲坝"更正为"三峡"(214)Beep'让计算机发出声音(215)‘返回错误代码(216)MsgBoxIMEStatus'获取输入法状态(217)Date=#6/6/2006#Time=#6:16:16AM#'将系统时间更改为2006年6月6日上午6时16分16秒(218)=Not'切换是否能利用鼠标中间的滑轮放大/缩小工作表(219)=True‘显示任务栏中的窗口,即各工作簿占用各自的窗口(220)=True‘显示窗口上的滚动条(221)=Not'切换是否显示编辑栏(222)(xlDialogPrint).Show‘显示打印内容对话框(223)=xlToRight'设置按Enter键后单元格的移动方向向右(224)'显示打开对话框(225)HYPERLINK‘打开超链接文档(226)Mode:=xlReadOnly'将当前工作簿设置为只读(227)'将当前工作簿添加到收藏夹文件夹中(228)'在当前工作表中执行"拼写检查"(229)userinterfaceonly:=True‘保护当前工作表侧页眉处打印出工作簿的完整路径和文件名(231)Worksheets("Sheet1").Range("A1:G37").Locked=FalseWorksheets("Sheet1").Protect'解除对工作表Sheet1中A1:G37区域单元格的锁定'以便当该工作表受保护时也可对这些单元格进行修改(232)Worksheets("Sheet1").PrintPreview'显示工作表sheet1的打印预览窗口(233)Enablechanges:=False‘禁用显示在Excel的“打印预览”窗口中的“设置”和“页边距”按钮预览中显示网格线预览中显示行列编号(235)'开启数据 记录 混凝土 养护记录下载土方回填监理旁站记录免费下载集备记录下载集备记录下载集备记录下载 单(236)Worksheets("Sheet1").Columns("A").Replace_What:="SIN",Replacement:="COS",_SearchOrder:=xlByColumns,MatchCase:=True'将工作表sheet1中A列的SIN替换为COS(237)Rows(2).Delete'删除当前工作表中的第2行Columns(2).Delete'删除当前工作表中的第单元格左侧插入一条垂直分页符单元格上方插入一条垂直分页符(239)=14'将当前工作表窗口滚动到第14行=13'将当前工作表窗口滚动到第13列(240)'关闭当前窗口获取当前窗口中的窗格数(242)Worksheets("sheet1").Range("A1:D2").CreateNamesTop:=True'将A2至D2的单元格名称设定为A1到D1单元格的内容(243)listarray:=Range("A1:A8")'自定义当前工作表中单元格A1至A8中的内容为自动填充序列(244)Worksheets("sheet1").Range("A1:B2").CopyPicturexlScreen,xlBitmap'将单元格A1至B2的内容复制成屏幕快照删除所选区域的所有链接Columns(1).‘删除第1列中所有的链接Rows(1). ‘删除第1行中所有的链接Range("A1:Z30").‘删除指定范围所有的链接开启Windows计算器",TextToDisplay:="Windows计算器"'在活动单元格中设置开启Windows计算器链接(247)=Shell("C:/Windows/System32/",vbNormalFocus)'开启Windows计算器(248)(1).AutoFilter‘打开自动筛选。若再运行一次,则关闭自动筛选(249)‘开启/关闭所选区域的自动筛选(250)‘关闭自动筛选(251)‘检查自动筛选是否开启,若开启则该语句返回True(252)("A").ColumnDifferences(Comparison:=ActiveSheet._Range("A2")).Delete'在A列中找出与单元格A2内容不同的单元格并删除(253)("A6").ClearNotes'删除单元格A6中的批注,包括声音批注和文字批注(254)("B8").ClearComments'删除单元格B8中的批注文字(255)("A1:D10").ClearFormats'清除单元格区域A1至D10中的格式(256)("B2:D2").BorderAroundColorIndex:=5,_Weight:=xlMedium,LineStyle:=xlDouble'将单元格B2至D2区域设置为蓝色双线(257)Range("A1:B2").Item(2,3)或Range("A1:B2")(2,3)‘引用单元格C2的数据Range("A1:B2")(3) ‘引用单元格A2(258)(1,1).=TRUE‘设置字体加粗(1,1).=24‘设置字体大小为24磅(1,1).=3‘设置字体颜色为红色(1,1).=TRUE‘设置字体为斜体(1,1).="TimesNewRoman"‘设置字体类型(1,1).=3‘将单元格的背景色设置为红色(259)("C2:E6").AutoFormatFormat:=xlRangeAutoFormatColor3'将当前工作表中单元格区域C2至E6格式自动调整为彩色3格式(260)(xlCellTypeLastCell)‘选中当前工作表中的最后一个单元格选定包含活动单元格的整个数组单元格区域.假定该单元格在数据单元格区域中(262)=";[红色]"'将当前单元格数字格式设置为带3位小数,若为负数则显示为红色(263)IsEmpty'判断活动单元格中是否有值(264)=LTrim'删除字符串前面的空白字符(265)Len'获取活动单元格中字符串的个数(266)=UCase'将当前单元格中的字符转换成大写(267)=StrConv,vbLowerCase)'将活动单元格中的字符串转换成小写(268)("C1").AddComment'在当前工作表的单元格C1中添加批注(269)Weekday(Date)'获取今天的星期,以数值表示,1-7分别对应星期日至星期六(270)("A1").AutoFillRange(Cells(1,1),Cells(10,1))'将单元格A1的数值填充到单元格A1至A10区域中(271)DatePart("y",Date)'获取今天在全年中的天数(272)=DateAdd("yyyy",2,Date)'获取两年后的今天的日期(273)MsgBoxWeekdayName(Weekday(Date))'获取今天的星期数(274)=Year(Date)'在当前单元格中输入今年的年份数=Month(Date)'在当前单元格中输入今天所在的月份数=Day(Date)'在当前单元格中输入今天的日期数(275)=MonthName(1)'在当前单元格中显示月份的名称,本句为显示"一月"(276)=Hour(Time)'在当前单元格中显示现在时间的小时数=Minute(Time)'在当前单元格中显示现在时间的分钟数=Second(Time)'在当前单元格中显示现在时间的秒数(277)(1).Delete'删除当前工作表中的第一个形状获取当前工作表中形状的数量(279)(1).'改变当前工作表中第一个艺术字的方向(280)(1).=True'将当前工作表中第一个艺术字的字体设置为斜体创建一个名为"三峡"的艺术字并对其进行格式设置和选中为起点(250,100)为终点画一条直线并选中宽为130高为72的三角形并选中为起点,宽130高72的矩形并选中宽为130高为72的椭圆线条颜色变为蓝色设置为红色(288)(1).Rotation=20'将当前工作表中的第1个形状旋转选中的形状水平翻转选中的形状垂直翻转选取的形状设置为第1种立体样式(291)(1).=20'将当前工作表中第一个立体形状的深度设置为进深部分的颜色设为蓝色(293)(1).=60'将当前工作表中的第1个立体形状沿X轴旋转60度(1).=60'将当前工作表中的第1个立体形状沿Y轴旋转选择的立体形状转换为平面形让指定的连接符起点脱离原来所连接的形状(296)(1).PickUp'复制当前工作表中形状输入内容输入内容张d盘中名为sx的图片(300)xl3DArea'将当前图表类型改为三维面积图  
本文档为【EXCELVBA编程的常用代码】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
该文档来自用户分享,如有侵权行为请发邮件ishare@vip.sina.com联系网站客服,我们会及时删除。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。
下载需要: 免费 已有0 人下载
最新资料
资料动态
专题动态
个人认证用户
前程无量
暂无简介~
格式:doc
大小:74KB
软件:Word
页数:0
分类:企业经营
上传时间:2021-09-15
浏览量:3