下载
加入VIP
  • 专属下载特权
  • 现金文档折扣购买
  • VIP免费专区
  • 千万文档免费下载

上传资料

关闭

关闭

关闭

封号提示

内容

首页 vba]-Excel VBA命令(转)

vba]-Excel VBA命令(转).doc

vba]-Excel VBA命令(转)

习惯你的习惯桥
2017-09-18 0人阅读 举报 0 0 暂无简介

简介:本文档为《vba]-Excel VBA命令(转)doc》,可适用于IT/计算机领域

vbaExcelVBA命令(转)本示例为设置密码窗口()IfApplicationInputBox("请输入密码:")=ThenA='密码正确时执行Else:MsgBox"密码错误即将退出!"'此行与第行共同设置密码EndIf本示例为设置密码窗口()X=MsgBox("是否真的要结帐?",vbYesNo)IfX=vbYesThenClose本示例为设置工作表密码ActiveSheetProtectPassword:='保护工作表并设置密码ActiveSheetUnprotectPassword:='撤消工作表保护并取消密码'本示例关闭除正在运行本示例的工作簿以外的其他所有工作簿并保存其更改内容。ForEachwInWorkbooksIfwNameThisWorkbookNameThenwCloseSaveChanges:=TrueEndIfNextw'每次打开工作簿时本示例都最大化MicrosoftExcel窗口。ApplicationWindowState=xlMaximized'本示例显示活动工作表的名称。MsgBox"Thenameoftheactivesheetis"ActiveSheetName'本示例保存当前活动工作簿的副本。ActiveWorkbookSaveCopyAs"C:TEMPXXXXXLS"'下述过程激活工作簿中的第四张工作表。Sheets()Activate'下述过程激活工作簿中的第张工作表。Worksheets()Activate'本示例通过将Saved属性设为True来关闭包含本段代码的工作簿并放弃对该工作簿的任何更改。ThisWorkbookSaved=TrueThisWorkbookClose'本示例对自动重新计算功能进行设置使MicrosoftExcel不对第一张工作表自动进行重新计算。Worksheets()EnableCalculation=False'下述过程打开C盘上名为MyFolder的文件夹中的MyBookxls工作簿。WorkbooksOpen("C:MyFolderMyBookxls")'本示例显示活动工作簿中工作表sheet上单元格A中的值。MsgBoxWorksheets("Sheet")Range("A")Value本示例显示活动工作簿中每个工作表的名称ForEachwsInWorksheetsMsgBoxheetChange(ByValTargetAsRange)DimiRowAsIntegeriRow=TargetRowApplicationEnableEvents=FalseCells(iRow,)=Cells(iRow,)Cells(iRow,)ApplicationEnableEvents=TrueEndSubPrivateSubWorksheetChange(ByValTargetAsRange)DimiRowAsIntegeriRow=TargetRow'ApplicationEnableEvents=FalseCells(iRow,)=Cells(iRow,)Cells(iRow,)'ApplicationEnableEvents=TrueEndSub这个程序的目的是要在B输入新的数时C会将B输入的新数加上C原有的数呈现在C上。照上面有加上ApplicationEnableEvents=False程序执行当然没问题。现在你在ApplicationEnableEvents=False与ApplicationEnableEvents=True前加上「'」看看。程序前加上「'」的目的是要使「'」之后的文字变成说明文字程序执行时是会跳过说明文字不执行说明文字的内容。程序前加上「'」符号后文字会变成绿色。执行第二个程序时你将发现C不会按你所要求的呈现结果。这就是所谓的事件连锁反应。请问这个宏该如何写!我想运行一个宏,就能在当前工作表B上填上一条公式这条公式的结果是所有工作表上的B单元格的和请问这个宏该如何写谢谢!Subgg()DimshAsWorksheet,shname$ForEachshInWorksheetsshname=shNameActiveSheetRange("b")value=ActiveSheetRange("b")valueWorksheets(shname)Range("b")NextEndSubVBA中怎样创建一个名为―table‖的新工作表通过VBA编程很容易添加新的工作表但是新表的名字不知怎样控制对于新创建的工作表由于其名字并非特定所以就不好使用所创建的新表了。不知各位有何高见。。。。SheetsAddActiveSheetName="table"请教:如何用VBA检索表中A列与表中A列相同的行并把后者整行拷贝到表检索到的行中,谢谢!!!!Toyxptwq用这程序试看看。SubCopy()DimRowdn,RowdnN,i,j,nAsIntegerRowdn=SheetRange("A")End(xlUp)Rowk=:n=ForEachwSheetInActiveWorkbookWorksheetsWithwSheetIfName"Sheet"ThenRowdnN=Range("A")End(xlUp)RowFori=ToRowdnForj=ToRowdnNIfCells(j,)=SheetCells(i,)ThenRows(j":"j)CopyDestination:=SheetRows(Rowdnn":"Rowdnn)n=nEndIfNextjNextiEndIfEndWithNextwSheetEndSub如果要用VBA程式输入密码使用下列程式码SubEnterNewPW()'程式说明:利用SendKey输入VBAProject密码'注意事项:执行本程式需要在Excel视窗,不能在VBE视窗ApplicationSendKeys"{F}",True'AltF切换到VBA视窗ApplicationSendKeys"T",True'ALTT工具(繁体中文是(T))ApplicationSendKeys"e",True'工具(T)VBproject属性(E)ApplicationSendKeys"^{TAB}",True'TAB键(切换到PAge保护页面)ApplicationSendKeys"{}",True'选取Checkbox方块(锁定专案以供检视)'({}选取,{}取消选取)ApplicationSendKeys"{TAB}",True'TAB键(跳到第一次输入密码TextboxmyPW="chijanzen"'假设密码chijanzenApplicationSendKeysmyPW,True'输入密码ApplicationSendKeys"{TAB}",True'TAB键(跳到第二次输入密码TextboxApplicationSendKeysmyPW,True'输入密码ApplicationSendKeys"{ENTER}",True'按确定钮(预设值)ApplicationSendKeys"{F}",True'返回Excel视窗EndSub冒泡排序法:冒泡排序法之所以成为―冒泡排序‖是因为值较小的或是较轻的元素浮到作为继续排序的一组数的顶部。SubMacro()DimiAsIntegerDimjAsIntegerDimtasintegerStaticnumber(To)AsIntegerFori=Tonumber(i)=inputbox―输入要排序的数:‖NextiFori=ToStepForj=Toi–下面进行位置交换Ifnumber(j)>number(j)Thent=number(j)number(j)=number(j)number(j)=tEndIfNextjNextiFori=ToPrintnumber(i)NextiEndsub首先定义一个数组:通过循环录入个整数然后用一个二重循环测试前一个数是否大于后一个数。如果大于则交换两个数的下标即交换两个数在数组中的位置交换通过一个变量来进行。我先用传统的方法解决这个问题经过比较选用了较为简单的和高效的排序方法―快速排序‖具体算法可参考数据结构等有关书籍。对所有数据排序后再合并相同数据合并程序较为简便我开始时采用了这种方法但后来发现对于这些的数据先合并后排序速度更快因为有大量相同的数据。合并是采用―标记‖算法具体如下:(设数据已存放在sData()数组中结果存到Queryp()数组Amount是数据个数)'把相同元素置Fori=ToAmountIfsData(i)ThenForj=i+ToAmountIfsData(i)=sData(j)ThensData(j)=NextjEndIfNexti'删除相同元素Queryp()=sData()k=Fori=ToAmountIfNot(sData(i)=)Thenk=k+Queryp(k)=sData(i)EndIfNextikMax=kReDimPreserveQueryp(kMax)虽然这样使得运算速度有所高但是仍然要进行大量的循环运算占据了程序大部分的运算时间。于是我一直在寻觅一种更为高效的算法。功夫不负有心人在仔细分析数据的特征比较了多种方案之后我终于找到了一种相当成功的算法原来要到秒的运算缩短到仅需到秒。我遇到的数据具有以下特征:相同数据很多最大、最小数之间相差不到都是带两位小数的正数。针对数据的特征我采用了以下算法:针对数据的特征我采用了以下算法:步骤:.用一个循环找出整数和小数部分的最大、最小值。小数部分的最大、最小值乘以转为整数。.定义一个二维数组下标范围分别是整数和小数部分的最小值到最大值。.再用一个循环把所有源数据填入刚才定义的二维数组填写规则是源数据的整数和小数部分分别对应二维数组的两个下标。例如―"填到―A(,)"中。.最后顺向或逆向读取二维数组中的非零数据即可得到从小到大或从大到小排列的数据而且不会含有重复数据。用VB编写的程序如下:'****密集型数据处理****DimiAsLong,jAsLong,kAsLong,kMaxAsLongDimQueryp()AsSingleReDimQueryp(Amount)DimIntegerPartAsInteger,DecimalPartAsIntegerDimIPmaxAsInteger,IPminAsIntegerDimDPmaxAsInteger,DPminAsIntegerDimDiffDataArray()'读取数据ReadDataIPmax=:IPmin=DPmax=:DPmin=Fori=ToAmount'找整数和小数部分的最大、最小值IntegerPart=Int(sData(i))DecimalPart=(sData(i)-IntegerPart)*IfIntegerPart>IPmaxThenIPmax=IntegerPartElseIfIntegerPartDPmaxThenDPmax=DecimalPartElseIfDecimalPartThenk=k+Queryp(k)=DiffDataArray(i,j)EndIfNextjNextikMax=kReDimPreserveQueryp(kMax)该方法对于本人遇到的这种―密集型‖数据最为有效但是如果遇上―稀疏型‖数据例如最大、最小值相差几千甚至上万的数据就没什么优势了而且会占用较大的内存。经过改进我得到了处理稀疏型数据的高效算法。高效的前提条件同样是源数据具有大量相同数据。思路是在前一种方法的基础上增加一个单维数组用来保存整数部分数据保存过程中用插入法对其进行排序。因为有大量重复数据要排序的数据量相对较少。当从二维数组中读取数据时用单维数组代入二维数组的第一个下标具体代码下:'****稀疏型数据处理****DimiAsLong,jAsLong,kAsLong,kMaxAsLongDimQueryp()AsSingleReDimQueryp(Amount)DimIntegerPartAsInteger,DecimalPartAsIntegerDimIPmaxAsInteger,IPminAsIntegerDimDPmaxAsInteger,DPminAsIntegerDimIPArray()AsInteger,IPAamountAsIntegerReDimIPArray(Amount)DimDiffDataArray()'读取数据ReadDataIPmax=:IPmin=DPmax=:DPmin=IPAamount=Fori=ToAmount'获取整数和小数部分的最大最小值IntegerPart=Int(sData(i))DecimalPart=(sData(i)-IntegerPart)*IfIntegerPart>IPmaxThenIPmax=IntegerPartElseIfIntegerPartDPmaxThenDPmax=DecimalPartElseIfDecimalPartIPArray(j)ThenIPAamount=IPAamount+Fork=IPAamountToj+Step-IPArray(k)=IPArray(k-)NextkIPArray(j)=IntegerPartExitForElseIfIntegerPart=IPArray(j)ThenExitForEndIfNextjIfj>IPAamountThenIPAamount=IPAamount+IPArray(IPAamount)=IntegerPartEndIfNextiReDimDiffDataArray(IPminToIPmax,DPminToDPmax)'填入数据Fori=ToAmountIntegerPart=Int(sData(i))DecimalPart=(sData(i)-IntegerPart)*DiffDataArray(IntegerPart,DecimalPart)=sData(i)Nexti'提取数据k=Fori=ToIPAamountForj=DPmaxToDPminStep-IfDiffDataArray(IPArray(i),j)Thenk=k+Queryp(k)=DiffDataArray(IPArray(i),j)EndIfNextjNextikMax=kReDimPreserveQueryp(kMax)kReDimPreserveQueryp(kMax)具体采用哪种算法要看数据的性质而定以下是本人的一些实测数据仅供参考。如果你有更好的方法可不要忘记和朋友们分享哦。自动隐藏表格中无数据的行表是数据源经常改变表引用表中某列有数据的单元格(利用动态位址已实现。)由于表的改变表的大小随之而变。问题:如何实现表中没有数据的行(有公式)自动隐藏?谢谢赐教!Subabc()Fori=ToIfCells(i,)value=""ThenRows(i)Hidden=TrueNextiEndSub你写的语句可以解决隐藏的问题可是如果我执行了它之后再在表中增加数据表不会自动显示有了数据的行。如何修改?将此宏设为自动运行(打开文件时)Subabc()Fori=ToIfCells(i,)value""ThenRows(i)Hidden=falseNextiEndSub用VBA如何自动合并列的内容?用VBA如何自动合并列的内容?Tohongjian:SubMergeTest()Fori=ToCells(i,)=Cells(i,)Chr()Cells(i,)NextEndSub基于VB和EXCEL的报表设计及打印在现代管理信息系统的开发中经常涉及到数据信息的分析、加工最终还需把统计结果形成各种形式的报表提供给领导决策参考或进行外部交流。在VisualBasic中制作报表通常是用数据环境设计器(DataEnvironmentDesigner)与数据报表设计器(DataReportDesigner),或者使用第三方产品来完成。但对于大多数习惯于Excel报表的用户而言,用以上方法生成的报表在格式和功能等方面往往不能满足他们的要求。由于Excel具有自己的对象库在VisualBasic工程中可以加以引用通过对Excel使用OLE自动化可以创建一些外观整洁的报表然后打印输出。这样实现了VisualBasi应用程序对Excel的控制。本文将针对一个具体实例阐述基于VB和EXCEL的报表设计及打印过程。)创建Excel对象Excel对象模型包括了个不同的对象从矩形、文本框等简单的对象到透视表图表等复杂的对象。下面简单介绍一下其中最重要也是用得最多的五个对象。()Application对象Application对象处于Excel对象层次结构的顶层表示Excel自身的运行环境。()Workbook对象Workbook对象直接地处于Application对象的下层表示一个Excel工作薄文件。()Worksheet对象Worksheet对象包含于Workbook对象表示一个Excel工作表。()Range对象Range对象包含于Worksheet对象表示Excel工作表中的一个或多个单元格。()Cells对象Cells对象包含于Worksheet对象表示Excel工作表中的一个单元格。如果要启动一个Excel使用Workbook和Worksheet对象下面的代码启动了Excel并创建了一个新的包含一个工作表的工作薄:DimzsbexcelAsExcelApplicationSetzsbexcel=NewExcelApplicationzsbexcelVisible=True如要Excel不可见可使zsbexcelVisible=FalsezsbexcelSheetsInNewWorkbook=Setzsbworkbook=zsbexcelWorkbooksAdd)设置单元格和区域值要设置一张工作表中每个单元格的值可以使用Worksheet对象的Range属性或Cells属性。WithzsbexcelActiveSheetCells(,)value=""Cells(,)value=""Cells(,)value="=SUM(B:B)"Range("A:A")="中国人民解放军"EndWith要设置单元格或区域的字体、边框可以利用Range对象或Cells对象的Borders属性和Font属性:WithobjexcelActiveSheetRange("A:K")Borders'边框设置Line=xlBorderLineWeight=xlThinColorIndex=EndWithWithobjexcelActiveSheetRange("A:K")Font'字体设置Size=Bold=TrueItalic=TrueColorIndex=EndWith通过对Excel单元格和区域值的各种设置的深入了解,可以创建各种复杂、美观、满足需要的、具有自己特点的报表。)预览及打印生成所需要的工作表后就可以对EXCEL发出预览、打印指令了。zsbexcelActiveSheetPageSetupOrientation=xlPortrait'设置打印方向zsbexcelActiveSheetPageSetupPaperSize=xlPaperA'设置打印纸的打下zsbexcelCaption="打印预览"'设置预览窗口的标题zsbexcelActiveSheetPrintPreview'打印预览zsbexcelActiveSheetPrintOut'打印输出通过打印方向、打印纸张大小的设置不断进行预览直到满意为止最终进行打印输出。为了在退出应用程序后EXCEL不提示用户是否保存已修改的文件,需使用如下语句:zsbexcelDisplayAlerts=FalsezsbexcelQuit'退出EXCELzsbexcelDisplayAlerts=True如此设计的报表打印是通过EXCEL程序来后台实现的。对于使用者来说根本看不到具体过程只看到一张张漂亮的报表轻易地被打印出来了。)具体实例下面给出一个具体实例它在window、VisualBasic、MicrosoftOffice的环境下调试通过。在VB中启动一个新的StandardEXE工程在―工程‖菜单的―引用‖选项下引用ExcelObjectLibrary然后在Form中添加一个命令按钮cmdExcel最后在窗体中输入如下代码:DimzsbexcelAsExcelApplicationPrivateSubcmdExcelClick()Setzsbexcel=NewExcelApplicationzsbexcelVisible=TruezsbexcelSheetsInNewWorkbook=Setzsbworkbook=zsbexcelWorkbooksAddWithzsbexcelActiveSheetRange("A:C")Borders'边框设置Line=xlBorderLineWeight=xlThinColorIndex=EndWithWithzsbexcelActiveSheetRange("A:C")Font'字体设置Size=Bold=TrueItalic=TrueColorIndex=EndWithzsbexcelActiveSheetRowsHorizontalAlignment=xlVAlignCenter'水平居中zsbexcelActiveSheetRowsVerticalAlignment=xlVAlignCenter'垂直居中WithzsbexcelActiveSheetCells(,)value=""Cells(,)value=""Cells(,)value="=SUM(B:B)"Cells(,)value="中国人民解放军"Range("A:A")=""EndWithzsbexcelActiveSheetPageSetupOrientation=xlPortrait'xlLandscapezsbexcelActiveSheetPageSetupPaperSize=xlPaperAzsbexcelActiveSheetPrintOutzsbexcelDisplayAlerts=FalsezsbexcelQuitzsbexcelDisplayAlerts=TrueSetzsbexcel=Nothing提高EXCEL中VBA的效率方法:尽量使用VBA原有的属性、方法和Worksheet函数由于Excel对象多达百多个对象的属性、方法、事件多不胜数对于初学者来说可能对它们不全部了解这就产生了编程者经常编写与Excel对象的属性、方法相同功能的VBA代码段而这些代码段的运行效率显然与Excel对象的属性、方法完成任务的速度相差甚大。例如用Range的属性CurrentRegion来返回Range对象该对象代表当前区。(当前区指以任意空白行及空白列的组合为边界的区域)。同样功能的VBA代码需数十行。因此编程前应尽可能多地了解Excel对象的属性、方法。充分利用Worksheet函数是提高程序运行速度的极度有效的方法。如求平均工资的例子:ForEachcInWorksheet()Range(″A:A″)Totalvalue=Totalvalue+cvalueNextAveragevalue=TotalvalueWorksheet()Range(″A:A″)RowsCount而下面代码程序比上面例子快得多:Averagevalue="blogApplicationWorksheetFunctionAverage(Worksheets()Range(″A:A″))其它函数如Count,Counta,Countif,Match,Lookup等等都能代替相同功能的VBA程序代码提高程序的运行速度。方法:尽量减少使用对象引用尤其在循环中每一个Excel对象的属性、方法的调用都需要通过OLE接口的一个或多个调用这些OLE调用都是需要时间的减少使用对象引用能加快VBA代码的运行。例如.使用With语句。Workbooks()Sheets()Range(″A:A″)FontName=″Pay″Workbooks()Sheets()Range(″A:A″)FontFont则以下语句比上面的快WithWorkbooks()Sheets()Range(″A:A″)FontName=″Pay″Font=″Bold″EndWith.使用对象变量。如果你发现一个对象引用被多次使用则你可以将此对象用Set设置为对象变量以减少对对象的访问。如:Workbooks()Sheets()Range(″A″)value=Workbooks()Sheets()Range(″A″)value=则以下代码比上面的要快:SetMySheet=Workbooks()Sheets()MySheetRange(″A″)value=MySheetRange(″A″)value=.在循环中要尽量减少对象的访问。Fork=ToSheets(″Sheet″)SelectCells(k,)value=Cells(,)valueNextk则以下代码比上面的要快:SetThevalue=Cells(,)valueSheets(″Sheet″)SelectFork=ToCells(k,)value=ThevalueNextk方法:减少对象的激活和选择如果你的通过录制宏来学习VBA的则你的VBA程序里一定充满了对象的激活和选择例如Workbooks(XXX)Activate、Sheets(XXX)Select、Range(XXX)Select等,但事实上大多数情况下这些操作不是必需的。例如Sheets(″Sheet″)SelectRange(″A″)value=Range(″A″)value=可改为:WithSheets(″Sheet″)Range(″A″)value=Range(″A″)value=EndWith方法:关闭屏幕更新如果你的VBA程序前面三条做得比较差则关闭屏幕更新是提高VBA程序运行速度的最有效的方法缩短运行时间左右。关闭屏幕更新的方法:ApplicationScreenUpdate=False请不要忘记VBA程序运行结束时再将该值设回来:ApplicationScreenUpdate=True以上是提高VBA运行效率的比较有效的几种方法本示例重复最近用户界面命令。本示例必须放在宏的第一行。ApplicationRepeat下例中变量counter代替了行号。此过程将在单元格区域C:C中循环将所有绝对值小于的数字都设置为(零)。SubRoundToZero()ForCounter=ToSetcurCell=Worksheets("Sheet")Cells(Counter,)IfAbs(curCellValue)Then'ApplicationActivePrinter="zdserverHPLaserJetPCL在Ne:"'指定打印机ActiveWindowSelectedSheetsPrintOutCopies:=myPrintNum,Collate:=True'设置打印信息,其中Copies:=myPrint为打印份数ElseMsgBox"请输入要打印的份数"EndIfActiveSheetShowAllData'全部显示ActiveSheetProtectPassword:='保护工作表并设置密码Sheets("封面")SelectApplicationScreenUpdating=TrueEndSubSub打印余额()ApplicationScreenUpdating=FalseSheets("余额表")SelectCall重算所有表ActiveSheetUnprotectPassword:='撤消工作表保护并取消密码ActiveWindowScrollColumn=SelectionAutoFilterField:=,Criteria:=""'以下行弹出窗口输入打印信息DimmyPrintNumAsIntegerDimmyPrompt,myTitleAsStringmyPrompt="请输入要打印的份数"myTitle="打印选取范围"myPrintNum=ApplicationInputBox(myPrompt,myTitle,,,,,,)IfmyPrintNumThen'ApplicationActivePrinter="zdserverHPLaserJetPCL在Ne:"''指定打印机ActiveWindowSelectedSheetsPrintOutCopies:=myPrintNum,Collate:=True'设置打印信息,其中Copies:=myPrint为打印份数ElseMsgBox"请输入要打印的份数"EndIfActiveSheetShowAllData'全部显示ActiveSheetProtectPassword:='保护工作表并设置密码Sheets("封面")SelectApplicationScreenUpdating=TrueEndSubSub备份()Dimy'变量声明需保存工作表的路径和名称M=ActiveWorkbookFullName'单元格M=当前工作簿的路径和名称y=cells(,)'Y=单元格N的值,即计算后的需保存工作簿的路径和名称Worksheets("封面")UsedRangeColumns("M:N")Calculate'计算指定区域ActiveWorkbookSaveCopyAsy'备份到指定路么YEndSubSub重算活动表()WithApplicationCalculation=xlManualMaxChange=EndWithActiveWorkbookPrecisionAsDisplayed=TrueActiveWindowDisplayZeros=TrueActiveSheetCalculateEndSubSub重算指定表()Attribute重算指定表VBProcDataVBInvokeFunc="zn"Worksheets("银行帐")CalculateWorksheets("日报表")CalculateEndSub单元格数据改变引起计算激活过程PrivateSubWorksheetChange(ByValTargetAsRange)Dimirow,icolAsIntegerirow=TargetRow'变量行irowicol=TargetColumn'变量列icolIfirow>Andicol=Andcells(irow,)>=cells(irow,)Then'>大于行,并且第列,当本行列>行列ApplicationEnableEvents=Falsecells(irow,)=cells(irow,)'本行列=上一行列ApplicationEnableEvents=TrueElseIfirow>Andicol=Andcells(irow,)大于行,并且第列,当本行列>行列ApplicationEnableEvents=Falsecells(irow,)=cells(irow,)'本行列=上行列ApplicationEnableEvents=TrueElseIf(icol=Oricol=Oricol=Oricol=Oricol=Oricol=Oricol=Oricol=)Andirow>Then'AndTarget""ApplicationEnableEvents=Falsecells(irow,)="=单位名称"cells(irow,)="=摘要"cells(irow,)="=余额"Range(cells(irow,),cells(irow,))="=预内外收支NOP"cells(irow,)="=审核Q"cells(irow,)="=对帐U"Range(cells(irow,),cells(irow,))="=内转收支XY"cells(irow,)="=政采Z"ApplicationEnableEvents=TrueEndIfEndSub'计算当前工作表路径及名称的函数,可作为单元格公式,也可写入宏=CELL("FILENAME")'改变Excel界面标题的宏PrivateSubWorkbookOpen()ApplicationCaption="吃过了"EndSub'自动刷新单元格A内显示的日期时间的宏Submytime()Range("a")=Now()ApplicationOnTimeNowTimeValue("::"),"mytime"EndSub'用单元格A的内容作为文件名保存当前工作簿的宏Subb()ActiveWorkbookSaveCopyAsRange("A")"xls"EndSub'激活窗体的宏,此宏写入有窗体的工作表内PrivateSubCommandButtonClick()'点数据录入按钮控件激活窗体LoadUserForm'激活窗体UserFormStartUpPosition='激活窗体UserFormShow'激活窗体EndSub'以下为窗体中点击各按钮运行的宏,写入窗体内PublicposAsInteger'声明变量pos'战友确定按钮语句PrivateSubCommandButtonClick()ApplicationScreenUpdating=False'此句和最后一句旨在不显示宏的执行过程'OnErrorGoToErrorHandle'可以不要'ErrorHandle:'可以不要'IfErrNumber=Then'可以不要'ExitSub'可以不要'EndIf'可以不要CallwriteToWorkSheet'执行宏writetoworksheetUserFormHide'退出窗体,继续按钮少此句,退出按钮执行此句UnloadUserForm'退出窗体,继续按钮少此句,退出按钮执行此句Call批量打印'此处到接顺序L=""'到此处结束Sheets("打印信息")SelectApplicationScreenUpdating=TrueEndSub'退出按钮语句PrivateSubCommandButtonClick()UserFormHideUnloadUserFormEndSub'将窗体内的文本框中的数据写进工作表的单元格PrivateSubwriteToWorkSheet()ActiveSheetRange("k")=TextBoxValue'将文字框内容写进k列ActiveSheetRange("l")=TextBoxValue'将文字框内容写进l列TextBoxValue=""'清空文字框内容TextBoxValue=""'清空文字框内容Worksheets("打印信息")Range("a")Value='给指定表的单元格写入数据Worksheets("打印信息")Range("B:E")Value=""'清空指定表的单元格数据EndSub'以下为根据条件打印的宏Sub打印()'部门明细查询及批星打印ApplicationScreenUpdating=False'关闭屏幕更新IfCells(,)=""AndCells(,)=""Then'打印条件Cells(,)=And'ApplicationActivePrinter="zdserverHPLaserJetPCL在Ne:"''指定打印机ActiveWindowSelectedSheetsPrintOutCopies:=,Collate:=True'设置默认打印机的打印信息,其中Copies:=myPrint为打印份数ElseCall打印信息'打倒为假时执行EndIfApplicationScreenUpdating=True'关闭屏幕更新EndSub'以下的循环过程,也用于批量打印,Z的值可以是Z=TO(到),也可是单元格的内容Sub批量打印()ForZ=Cells(,)ToCells(,)'变量X的值从打印起始号K到结束号L之间逐渐递增Cells(,)=Z'M的值等于变量XNextZEndSub'以下是将打印情况写入工作表的宏Sub打印信息()ApplicationScreenUpdating=False'关闭屏幕更新DimY'声明变量Y=ActiveSheetName'判定活动工作表名称Sheets("打印信息")SelectX='从第行开始DoWhileNot(IsEmpty(Cells(X,)Value))'判断第列的最后一行(即空行的上一行)X=X'在最后一行加一行即为空行LoopCells(X,)=Cells(,)Cells(X,)=Sheets(Y)Cells(,)Cells(,)=Cells(,)Cells(X,)=Sheets(Y)Cells(,)Cells(X,)=Sheets(Y)Cells(,)c=YSheets(Y)Select'返回上一次打开的工作表ApplicationScreenUpdating=True'打开屏幕更新EndSub将文件保存为以某一单元格中的值为文件名的宏怎么写假设你要以Sheet的A单元格中的值为文件名保存则应用命令:ActiveWorkbookSaveCopyAsStr(Range("Sheet!A"))"xls"在Excel中,如何用程式控制某一单元格不可编辑修改thanks!!!PrivateSubWorkbookOpen()ProtectSpecialRange("A")EndSubSubProtectSpecialRange(RangeAddressAsString)OnErrorResumeNextWithSheetCellsLocked=FalseRange(RangeAddress)Locked=TrueProtectionAllowEditRangesAddTitle:="区域",Range:=Range(RangeAddress),Password:="pass"ProtectDrawingObjects:=True,Contents:=True,Scenarios:=TrueEndWithEndSub对工作表编程有时要判断工作表的记录总数VBA里如何实现?x=dowhilenot(isempty(sheets("")cells(x,)value)x=xloop在VBA中等同于EXCELE中的求和函数sum()的函数是什么ApplicationWorksheetFunctionSum()自定义菜单有三个菜单项要求手工顺序执行。为防止误操作执行完第一个菜单项后使其变灰(禁用)如何写?Rowen令其Enable属性同步与某个工具按钮是较为方便的。如何进行表格更新?是这样的比如我已经有了一个原始表格A这时有人通知我A表有错误须加以修改并给我一个表B表B列出了须修改的参数(注意B的列数少于A的列数因A的其他列无需修改)。现在问题是如何根据表B中的新值在表A中找到相应位置并加以修改。比如表B中列出了的JOHN的身高和体重等值需要修改如何在A中找到的相应位置(身高体重)并加以修改。建議將表b複製至表a的sheet然後執行下列的宏即可subchange()dimddasrangesheets()selectlastcell=range("a")end(xlup)rowforeachddinrange(cells(,),cells(lastcell,))ifdd=""thenexitsubff=ddvaluesetc=sheets()columns()find(ff,lookat:=xlwhole)ifnotcisnothingthencoffset(,)=ddoffset(,)coffset(,)=ddoffset(,)coffset(,)=ddoffset(,)endifnextendsub自定义菜单把建立和删除自定义菜单的代码分别写在Workbookopen和Workbookbeforeclosed的事件中。应该用VBA工作薄代码中有workbookopen()过程在该过程中写入withactiveworkbooksheets("表")activeendwithVBA实现向锁定工作表中插入行,并自动复制上面行中指定列的函数OptionExplicitPublicConststrPass=""是口令Sub行上再插入一行()ActiveSheetUnprotectpassword:=strPassSelectionCopySelectionInsertShift:=xlDownSelectionPasteSpecialPaste:=xlFormats,Operation:=xlNone,SkipBlanks:=False,Transpose:=FalseApplicationCutCopyMode=FalseActiveSheetProtectpassword:=strPassEndSub如何使不出现每次关闭XLS文件时出现的:―XXXxls文件已被修改是否可在其修改后的内容?‖字样??可以在工作表关闭之前进行手工保存工作ThisWorkbooksave如何实现动态时间显示submytimerange("a")=now()ApplicationOnTimeNowTimevalue("::"),"mytime"endsub用vba判断指定excel文件是否打开?ForEachwInWorkbooksIfwNameXXXThen…………EndIfNextwvba怎么调用excel自带的函数比如vlookupApplicationWorksheetFunctionf(x)f(x)是你想使用的工作表函数但是用内部函数时引用单元格会出错怎么办?把你要引用的单元格改成VBA认可格式(类型)。如在Excel中的―F:F‖应改为―Range("F:F")‖等。VBA中如何关闭,保存和退出ExcelWorkbooks("你的工作簿")Save。下表举例说明了使用Rows和Columns属性的一些行和列的引用。引用含义Rows()第一行Rows工作表上所有的行Columns()第一列Columns("A")第一列Columns工作表上所有的列若要同时处理若干行或列请创建一个对象变量并使用Union方法将对Rows属性或Columns属性的多个调用组合起来。下例将活动工作簿中第一张工作表上的第一行、第三行和第五行的字体设置为加粗。SubSeveralRows()Worksheets("Sheet")ActivateDimmyUnionAsRangeSetmyUnion=Union(Rows(),Rows(),Rows())myUnionFontBold=TrueEndSub如果只是你说的只连接几个储存格那用简单的方法Range("A")Formula=ApplicationEvaluate("=BookxlsSheet!A")或Range("A")Formula="=BookxlsSheet!A"请问在vba如何呼叫已定义的名称范围我在a:b插入名称myrange请问我如何用vba选取此范围Range("myrange")Select如何访问没有打开的EXCEL文件?SubAlternativeImport()DimxlappAsExcelApplicationDimwbSourceAsExcelWorkbookSetxlapp=NewExcelApplicationxlappEnableEvents=FalseSetwbSource=xlappWorkbooksOpen("C:testBookxls")Range("A:A")Value=wbSourceSheets("Sheet")Range("A:A")ValuewbSourceCloseFalsexlappQuitEndSub怎样使VBAprject工程不可查看?(不用密码)用可编辑十六进制文件的软件工具(如WinHex等)打开Excelxls,在文件的尾部,查找ID="{}"(有工程锁定密码时),或ID="{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}"(没有工程锁定密码时),修改其中的任意位后,保存,即可达到目的当查看工程是会出现―工程不可查看‖的提示注意:修改前,一定要备份原文件,以防不测如何用VBA控制报表的格式(左边距纸张大小打印第几页等)打印第几页控制:ActiveWindowSelectedSheetsPrintOutFrom:=x,To:=yActiveSheetPageSetupLeftMargin=左边距ActiveSheetPageSetupPaperSize=纸张大小如何使VBA自动消除使用COPY复制后产生的虚线框?ApplicationCutCopyMode=False替换Excel的菜单栏是很容易的只需创建一个新的菜单栏就会删除Excel的菜单栏。当需要恢复Excel的菜单栏时只要删除新创建的菜单栏就可以了。该系统的自定义菜单中只需两个命令按钮一个用来返回到系统的主画面(ReturnMAIN)另一个用来退出系统(ExitSYS)。下面是模块(Module)中有关的宏或是事件控制程序。SubZapMenu()OnErrorResumeNextCommandBars(―保险查询系统‖)DeleteEndSub这是一个用来删除自定义菜单栏的宏。语句OnErrorResumeNext保证无论自定义菜单栏是否存在都能正确删除它。SubExitSYS()ZapMenuActiveWorkbookCloseSaveChanges:=FalseEndSub这是用来退出系统的宏。它删除自定义菜单并关闭活动的工作簿(不提示保存修改)。SubReturnMAIN()Worksheets(―保险查询系统‖)SelectEndSub该宏用来返回主画面。它激活―保险查询系统‖工作表。SubSetMenu()DimmyBarAsCommandBarDimmyButtonAsCommandBarButtonZapMenuSetmyBar=CommandBarsAdd(Name:=―保险查询系统‖,Position:=msoBarTop,MenuBar:=True)SetmyButton=myBarControlsAdd(msoControlButton)myButton=msoButtonCaptionmyButtonCaption=―退出E‖myButtonOnAction=―ExitSYS‖SetmyButton=myBarControlsAdd(msoControlButton)myButton=msoButtonCaptionmyButtonCaption=―返回R‖myButtonOnAction=―ReturnMAIN‖myButtonVisible=FalsemyBarProtection=msoBarNoMovemsoBarNoCustomizemyBarVisible=TrueEndSub这个宏包含五部分。第一部分定义了一对变量。第二部分首先运行ZapMenu宏保证保险查询系统菜单栏是不存在的然后创建它。参数MenuBar的值设为True确保这个新创建的命令栏为一菜单栏。第三部分和第四部分将两个命令按钮加入到菜单栏中。并设置ReturnMAIN命令按钮的初始状态为不可见状态。最后一部分保护这个新创建的菜单栏使用户不能移动也不能自定义新菜单栏。工作表汇总Subsum()'表汇总,第张的a:e等于所有表的相同单元格的和AttributesumVBProcDataVBInvokeFunc="zn"DimXAsWorksheetFory=ToForz=ToForEachXInWorksheetsshname=XNameActiveSheetCells(y,z)Value=ActiveSheetCells(y,z)ValueWorksheets(shname)Cells(y,z)NextNextzNextyEndSu

用户评价(0)

关闭

新课改视野下建构高中语文教学实验成果报告(32KB)

抱歉,积分不足下载失败,请稍后再试!

提示

试读已结束,如需要继续阅读或者下载,敬请购买!

文档小程序码

使用微信“扫一扫”扫码寻找文档

1

打开微信

2

扫描小程序码

3

发布寻找信息

4

等待寻找结果

我知道了
评分:

/67

vba]-Excel VBA命令(转)

VIP

在线
客服

免费
邮箱

爱问共享资料服务号

扫描关注领取更多福利