VBS操作EXCEL常见方法

SetoExcel=CreateObject(\"Excel.Application\")

SetoWb=oExcel.Workbooks.Open(\"E:\\其他\\新装电话表.xls\")SetoSheet=oWb.Sheets(\"Sheet1\")

MsgBoxoSheet.Range(\"B2\").Value'#提取单元格B2内容'.....

3、如果是XP系统，可以使用如下代码DimobjFileDlg

SetobjFileDlg=CreateObject(\"UserAccounts.CommonDialog\")objFileDlg.Filter=\"ExcelFile(*.xls)|*.xls\"IfobjFileDlg.ShowOpenThen

msgbox\"您选择的文件是：\"&objFileDlg.FileName&vbCrLfEndIf

VBS控制Excel的一些常见方法：(一)使用动态创建的方法

首先创建Excel对象，使用ComObj:

oExcel=CreateObject(\"Excel.Application\")1)显示当前窗口：

oExcel.Visible=True2)更改Excel标题栏：

oExcel.Caption=\"应用程序调用MicrosoftExcel\"3)添加新工作簿：

oExcel.WorkBooks.Add4)打开已存在的工作簿：

oExcel.WorkBooks.Open(\"C:\\Excel\\Demo.xls\")5)设置第2个工作表为活动工作表：oExcel.WorkSheets(2).Activate或

oExcel.WorksSheets(\"Sheet2\").Activate6)给单元格赋值：

oExcel.Cells(1,4).Value=\"第一行第四列\"

7)设置指定列的宽度（单位：字符个数），以第一列为例：oExcel.ActiveSheet.Columns(1).ColumnsWidth=5

8)设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：oExcel.ActiveSheet.Rows(2).RowHeight=1/0.035'1厘米9)在第8行之前插入分页符：

oExcel.WorkSheets(1).Rows(8).PageBreak=110)在第8列之前删除分页符：

oExcel.ActiveSheet.Columns(4).PageBreak=011)指定边框线宽度：

oExcel.ActiveSheet.Range(\"B3:D4\").Borders(2).Weight=3

1-左2-右3-顶4-底5-斜(\\)6-斜(/)12)清除第一行第四列单元格公式：

oExcel.ActiveSheet.Cells(1,4).ClearContents13)设置第一行字体属性：

oExcel.ActiveSheet.Rows(1).Font.Name=\"隶书\"oExcel.ActiveSheet.Rows(1).Font.Color=clBlueoExcel.ActiveSheet.Rows(1).Font.Bold=True

oExcel.ActiveSheet.Rows(1).Font.UnderLine=True14)进行页面设置：a.页眉：

oExcel.ActiveSheet.PageSetup.CenterHeader=\"报表演示\"b.页脚：

oExcel.ActiveSheet.PageSetup.CenterFooter=\"第&P页\"c.页眉到顶端边距2cm：

oExcel.ActiveSheet.PageSetup.HeaderMargin=2/0.035d.页脚到底端边距3cm：

oExcel.ActiveSheet.PageSetup.HeaderMargin=3/0.035e.顶边距2cm：

oExcel.ActiveSheet.PageSetup.TopMargin=2/0.035f.底边距2cm：

oExcel.ActiveSheet.PageSetup.BottomMargin=2/0.035g.左边距2cm：

oExcel.ActiveSheet.PageSetup.LeftMargin=2/0.035h.右边距2cm：

oExcel.ActiveSheet.PageSetup.RightMargin=2/0.035i.页面水平居中：

oExcel.ActiveSheet.PageSetup.CenterHorizontally=2/0.035j.页面垂直居中：

oExcel.ActiveSheet.PageSetup.CenterVertically=2/0.035k.打印单元格网线：

oExcel.ActiveSheet.PageSetup.PrintGridLines=True15)拷贝操作：a.拷贝整个工作表：

oExcel.ActiveSheet.Used.Range.Copyb.拷贝指定区域：

oExcel.ActiveSheet.Range(\"A1:E2\").Copyc.从A1位置开始粘贴：

oExcel.ActiveSheet.Range.(\"A1\").PasteSpeciald.从文件尾部开始粘贴：

oExcel.ActiveSheet.Range.PasteSpecial16)插入一行或一列：

a.oExcel.ActiveSheet.Rows(2).Insertb.oExcel.ActiveSheet.Columns(1).Insert

17)删除一行或一列：

a.oExcel.ActiveSheet.Rows(2).Deleteb.oExcel.ActiveSheet.Columns(1).Delete18)打印预览工作表：

oExcel.ActiveSheet.PrintPreview19)打印输出工作表：

oExcel.ActiveSheet.PrintOut20)工作表保存：

ifnotoExcel.ActiveWorkBook.SavedthenoExcel.ActiveSheet.PrintPreview21)工作表另存为：

oExcel.SaveAs(\"C:\\Excel\\Demo1.xls\")22)放弃存盘：

oExcel.ActiveWorkBook.Saved=True23)关闭工作簿：

oExcel.WorkBooks.Close24)退出Excel：oExcel.Quit

(二)使用VBS控制Excle二维图1）选择当第一个工作薄第一个工作表

setoSheet=oExcel.Workbooks(1).Worksheets(1)2）增加一个二维图

achart=oSheet.chartobjects.add(100,100,200,200)3）选择二维图的形态

achart.chart.charttype=44）给二维图赋值

setseries=achart.chart.seriescollectionrange=\"sheet1!r2c3:r3c9\"series.addrange,true5）加上二维图的标题

achart.Chart.HasTitle=True

achart.Chart.ChartTitle.Characters.Text=\"Excle二维图\"6）改变二维图的标题字体大小

achart.Chart.ChartTitle.Font.size=187）给二维图加下标说明

achart.Chart.Axes(xlCategory,xlPrimary).HasTitle=True

achart.Chart.Axes(xlCategory,xlPrimary).AxisTitle.Characters.Text=\"下标8）给二维图加左标说明

achart.Chart.Axes(xlValue,xlPrimary).HasTitle=True

achart.Chart.Axes(xlValue,xlPrimary).AxisTitle.Characters.Text=\"左标说明9）给二维图加右标说明

achart.Chart.Axes(xlValue,xlSecondary).HasTitle=True

achart.Chart.Axes(xlValue,xlSecondary).AxisTitle.Characters.Text=\"右标说10）改变二维图的显示区大小

achart.Chart.PlotArea.Left=5achart.Chart.PlotArea.Width=223achart.Chart.PlotArea.Height=108

如何用vbs把excel的单元格数据写到txt复制代码代码如下:

IfWScript.Arguments.Count>0ThenFilename=WScript.Arguments(0)Seta=CreateObject(\"Excel.Application\")IfFilename=\"\"Then

Filename=a.GetOpenFilename(\"ExcelFiles(*.xls),*.xls\")IfVarType(Filename)=vbBooleanThen

MsgBox\"Excel2Txt用于将Excel文件的每个Sheet保存为一个文本文件。\"&vbCr&vbLExcel2Txtfilename.xls或在对话框中打开Excel文件。\"WScript.QuitEndIfEndIf

Setw=a.Workbooks.Open(Filename)

n=Replace(Replace(w.Name,\".xls\\"\"),\".XLS\\"\")a.DisplayAlerts=FalseForEachsInw.Sheets

s.SaveAsw.Path&\"\\\"&n&\"_\"&s.Name&\".txt\20Nexta.Quit

把以上代码存为Excel2Txt.vbs双击执行就行了

VBS操作Excel复制代码代码如下:

SetobjExcel=CreateObject(\"Excel.Application\")'建一个exel对象SetobjWorkbook=objExcel.Workbooks.Open_(\"E:\\DOC\\Hewl\\领域模型.xls\")'打开文件

strToBeWrited=\"-----------------------------------\"&vbcrlf&_\"--GeneratedbyScriptGenerator---\"&vbcrlf&_

\"-----------------------------------\"&vbcrlf&vbcrlfCount=objWorkbook.WorkSheets.Count'取sheet数量Setmy=CreateObject(\"Excel.Sheet\")'新建sheet对象ForEachmyInobjWorkbook.WorkSheets'遍历sheet

Ifmy.Name=\"目录\"ormy.Name=\"SecondHandHouse\"Then'donothingElse

'Wscript.Echomy.Name'获得sheet名字'Wscript.Echomy.Rows.Count

'strToBeWrited=strToBeWrited&\"createtable\"&my.Name&vbcrlf

strToBeWrited=strToBeWrited&\"/*======================================&vbcrlf

strToBeWrited=strToBeWrited&\"/*Table:\"&my.Name&\"*/\"&vbcrlfstrToBeWrited=strToBeWrited&\"/*======================================&vbcrlf

strToBeWrited=strToBeWrited&\"createtable\"&my.Name&\"(\"&vbcrlfrowNum=3

DoUntilmy.Cells(rowNum,1).Value=\"\"

'Wscript.Echo\"sAMAccountName:\"&my.Cells(rowNum,2).Value

strToBeWrited=strToBeWrited&\"\"&my.Cells(rowNum,2).Value&\"\"&mynotnull\"

Ifnotmy.Cells(rowNum,9).Value=\"\"Then

strToBeWrited=strToBeWrited&\"default\"&my.Cells(rowNum,9).ValueEndIf

strToBeWrited=strToBeWrited&\&vbcrlfrowNum=rowNum+1Loop

strToBeWrited=strToBeWrited&\"constraintPK_\"&my.Name&\"primarykstrToBeWrited=strToBeWrited&\")\"&vbcrlfEndIf

strToBeWrited=strToBeWrited&vbcrlfNext

ForEachmyInobjWorkbook.WorkSheets'遍历sheet

Ifmy.Name=\"目录\"ormy.Name=\"SecondHandHouse\"Then'donothingElse

strToBeWrited=strToBeWrited&\"constraintPK_\"&my.Name&\"primarykstrToBeWrited=strToBeWrited&\")\"&vbcrlfEndIf

strToBeWrited=strToBeWrited&vbcrlfNext'写文件

setfs=createobject(\"scripting.filesystemobject\")

setf=fs.opentextfile(\"E:\\DOC\\Hewl\\dbscript.sqlrue)'Wscript.EchostrToBeWritedf.writestrToBeWritedf.close

Setf=nothingSetfs=nothing

objExcel.Quit'结束退出

复制代码代码如下:DimExcelSetExcel=CreateObject(\"Excel.Application\")'不显示提示信息,这样保存的时候就不会提示是否要覆盖原文件Excel.DisplayAlerts=FALSE'调用EXCEL文件的时候不显示

Excel.visible=FALSE

Excel.workbooks.open(\"D:\est.XLS\")'将sheet1设置为活动sheet

Excel.workbooks(1).activate

'插入行,这条我找MSDN都没找到,最后乱试试出来的Excel.ActiveSheet.rows(1).insert

Excel.ActiveSheet.Cells(1,1).Value=DateExcel.ActiveSheet.Cells(1,2).Value=\"row1\"

Excel.ActiveSheet.Cells(1,3).Value=\"comment1\"Excel.ActiveSheet.rows(2).insert

Excel.ActiveSheet.Cells(2,1).Value=DateExcel.ActiveSheet.Cells(2,4).Value=\"row2\"

Excel.ActiveSheet.Cells(2,7).Value=\"comment2\"Excel.saveExcel.quit

SetExcel=Nothing

Excel.ActiveSheet.rows(1).insert

不用找MSDN，在EXCEL帮助中就能找到，看“编程信息”/“MicrosoftExcelVisualBasic性”的介绍，和“编程信息”/“MicrosoftExcelVisualBasic参考”/“方法”/“I-L”/“Inse的语法。

因为在EXCEL的VBA中，“Rows”、“Columns”、“Cells”属性返回的都是Range对象，所以对用。

例如：你在EXCEL的VBA编辑器中可以这样写cells(1,1).value=\"abc\"cells(1,1).wraptext=false

在写这些语句时，你应该注意到，在写完“cells(1,1).”之后，并没有弹出应该弹出的属性/方法列行。

我的方法是：在EXCEL中录制宏，然后在EXCEL的VBA编辑器中修改语句，调试运行无误后再粘贴

一、声明变量

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、用户定义类型或对象类型。二、声明常数

ConstConstMy=456'常数的默认状态是Private。PublicConstMyString=\"HELP\"'声明Public常数。

PrivateConstMyIntAsInteger=5'声明PrivateInteger常数。

ConstMyStr=\"Hello\MyDoubleAsDouble=3.4567'在同一行里声明多个常数。

三、行数列数

查看行数：hang=sheet.UsedRange.Rows.Count

EndRow=Sheets(sheetsCaption).Range(Col&\"65536\").End(xlUp).Row查看列数：lie=sheet.UsedRange.Columns.Count返回选定区域的行数：MsgBoxSelection.Rows.Count返回选定区域的列数：MsgBoxSelection.Columns.Count返回选定区域的地址：Selection.Address

四、赋值：

Workbooks(\"12.xls\").Worksheets(\"sheet2\").Range(\"B5\").Value=\"abcde\"Sheets(\"sheet1\").Range(\"a1\").Value=\"hello\"sheets(\"sheet2\").selectRange(\"a1\").value=\"hello\"

Sheets(\"sheet1\").Range(\"a1\")selectActiveCell.Value=\"你好！！！\"

五、工作表相关：

ActiveSheet.Name=\"liu\"'给活动工作表改名\"liu\"Worksheets.Add'增加一个工作表activesheet.delete'删除活动工作表

Workbooks.OpenFileName:=\"C:\\MyDocuments\\Book2.xls\"'打开一个工作簿文件ActiveWindow.Close'关闭活动窗口WithSheets(\"sheet1\")'设定操作区域EndWith

示例：

Application.ScreenUpdating=False

DimsheetsCaptionAsString:sheetsCaption=\"Sheet4\"

DimEndRowAsInteger:EndRow=Sheets(sheetsCaption).Range(\"B\"&

\"65536\").End(xlUp).RowDimiAsInteger:i=1WithSheets(sheetsCaption)Do

i=i+1

Range(\"d\"&i).Value=Range(\"b\"&i).Value&Range(\"c\"&i).ValueLoopWhileiApplication.ScreenUpdating=True

六、行的操作：

Rows(i&\":\"&i).Select'剪切I行到４行上面Selection.Cut

Rows(\"4:4\").Select

Selection.InsertShift:=xlDown

七、单元格位移：submy_offset

ActiveCell.Offset(0,1).Select'当前单元格向左移动一格ActiveCell.Offset(0,-1).Select'当前单元格向右移动一格ActiveCell.Offset(1,0).Select'当前单元格向下移动一格ActiveCell.Offset(-1,0).Select'当前单元格向上移动一格endsub

八、单元格的设置：

Range(\"A5\").Select'设置成红色WithSelection.Interior.ColorIndex=3

九、报错：

如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往submy_offset之下加一段代码onerrorresumenext忽略所有的错误

ONERRORRESUMENEXT遇错跳转：

onerrorgotoerr_handle'中间的其他代码err_handle:'标签

'跳转后的代码十、单元格格式：

ActiveCell.Clear'清除单元格:删除所有文字、批注、格式Selection.HorizontalAlignment=xlLeft'选定单元格左对齐Selection.HorizontalAlignment=xlCenter'选定单元格居中Selection.HorizontalAlignment=xlRight'选定单元格右对齐Selection.Style=\"Percent\"'选定单元格为百分号风格Selection.Font.Bold=True'选定单元格字体为粗体Selection.Font.Italic=True'选定单元格字体为斜体WithSelection.Font'选定单元格字体为宋体20号字.Name=\"宋体\".Size=20EndWith

msgboxActiveCell.Address'得到当前单元格的地址msgboxdate&chr(13)&time'得到当前日期及时间十一、VBA专属特性：

删除一个文件：kill\"c:\\1.txt\"

定制自己的状态栏：Application.StatusBar=\"现在时刻:\"&Time恢复自己的状态栏：Application.StatusBar=false用代码执行一个宏：Application.Runmacro:=\"text\"滚动窗口到a1的位置：ActiveWindow.ScrollRow=1：ActiveWindow.ScrollColumn=1定制系统日期

DimMyDate,MyDayMyDate=#12/12/69#MyDay=Day(MyDate)返回当天的时间DimMyDate,MyYearMyDate=Date

MyYear=Year(MyDate)MsgBoxMyYear

inputbox<输入框>：XX=InputBox(\"Enternumberofmonthstoadd\")得到一个文件名DimkkAsString

kk=Application.GetOpenFilename(\"EXCEL(*.XLS),*.XLS\Title:=\"提示：请打开一个EXCEL文件：\")msgboxkk

打开zoom（显示比例）对话框：Application.Dialogs(xlDialogZoom).Show激活字体对话框：Application.Dialogs(xlDialogActiveCellFont).Show打开另存对话框DimkkAsString

kk=Application.GetSaveAsFilename(\"excel(*.xls),*.xls\")Workbooks.Openkk

返回当前单元格中数据删除前后空格后的值submy_trim

msgboxTrim(ActiveCell.Value)endsub

保护工作簿：ActiveSheet.Protect取消保护工作簿：ActiveSheet.Unprotect

打开一个应用程序：AppActivate(Shell(\"C:\\WINDOWS\\CALC.EXE\"))隐藏SHEET1这张工作表：sheets(\"sheet1\").Visible=False显示SHEET1这张工作表：sheets(\"sheet1\").Visible=True

打印预览：有时候我们想把所有的EXCEL中的SHEET都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿结束循环预览。DimmyAsWorksheet

ForEachmyInWorksheetsmy.PrintPreviewNextmy