您的位置：360文档中心› VBS操作EXCEL常见方法

VBS操作EXCEL常见方法

VBS操作EXCEL常见方法
VBS操作EXCEL常见方法

VBS操作Excel常见方法

dim oExcel,oWb,oSheet

Set oExcel=CreateObject("Excel.Application")

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

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

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

Dim objFileDlg

Set objFileDlg=CreateObject("https://www.360docs.net/doc/f82245364.html,monDialog") objFileDlg.Filter="Excel File(*.xls)|*.xls"

If objFileDlg.ShowOpen Then

msgbox"您选择的文件是："&objFileDlg.FileName&vbCrLf End If

VBS控制Excel的一些常见方法：

(一)使用动态创建的方法

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

oExcel=CreateObject("Excel.Application")

1)显示当前窗口：

oExcel.Visible=True

2)更改Excel标题栏：

oExcel.Caption="应用程序调用Microsoft Excel"

3)添加新工作簿：

oExcel.WorkBooks.Add

4)打开已存在的工作簿：

oExcel.WorkBooks.Open("C:\Excel\Demo.xls")

5)设置第2个工作表为活动工作表：

oExcel.WorkSheets(2).Activate

或

oExcel.WorksSheets("Sheet2").Activate

6)给单元格赋值：

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=1

10)在第8列之前删除分页符：

oExcel.ActiveSheet.Columns(4).PageBreak=0

11)指定边框线宽度：

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

1-左2-右3-顶4-底5-斜(\)6-斜(/)

12)清除第一行第四列单元格公式：

oExcel.ActiveSheet.Cells(1,4).ClearContents

13)设置第一行字体属性：

oExcel.ActiveSheet.Rows(1)https://www.360docs.net/doc/f82245364.html,="隶书"

oExcel.ActiveSheet.Rows(1).Font.Color=clBlue oExcel.ActiveSheet.Rows(1).Font.Bold=True

oExcel.ActiveSheet.Rows(1).Font.UnderLine=True

14)进行页面设置：

a.页眉：

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

oExcel.ActiveSheet.PageSetup.CenterFooter="第&P页"

c.页眉到顶端边距2cm：

oExcel.ActiveSheet.PageSetup.HeaderMargin=2/0.035

d.页脚到底端边距3cm：

oExcel.ActiveSheet.PageSetup.HeaderMargin=3/0.035

e.顶边距2cm：

oExcel.ActiveSheet.PageSetup.TopMargin=2/0.035

f.底边距2cm：

oExcel.ActiveSheet.PageSetup.BottomMargin=2/0.035

g.左边距2cm：

oExcel.ActiveSheet.PageSetup.LeftMargin=2/0.035

h.右边距2cm：

oExcel.ActiveSheet.PageSetup.RightMargin=2/0.035

i.页面水平居中：

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

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

oExcel.ActiveSheet.PageSetup.PrintGridLines=True

15)拷贝操作：

a.拷贝整个工作表：

https://www.360docs.net/doc/f82245364.html,ed.Range.Copy

b.拷贝指定区域：

oExcel.ActiveSheet.Range("A1:E2").Copy

c.从A1位置开始粘贴：

oExcel.ActiveSheet.Range.("A1").PasteSpecial

d.从文件尾部开始粘贴：

oExcel.ActiveSheet.Range.PasteSpecial

16)插入一行或一列：

a.oExcel.ActiveSheet.Rows(2).Insert

b.oExcel.ActiveSheet.Columns(1).Insert

17)删除一行或一列：

a.oExcel.ActiveSheet.Rows(2).Delete

b.oExcel.ActiveSheet.Columns(1).Delete

18)打印预览工作表：

oExcel.ActiveSheet.PrintPreview

19)打印输出工作表：

oExcel.ActiveSheet.PrintOut

20)工作表保存：

if not oExcel.ActiveWorkBook.Saved then

oExcel.ActiveSheet.PrintPreview

21)工作表另存为：

oExcel.SaveAs("C:\Excel\Demo1.xls")

22)放弃存盘：

oExcel.ActiveWorkBook.Saved=True

23)关闭工作簿：

oExcel.WorkBooks.Close

24)退出Excel：

oExcel.Quit

(二)使用VBS控制Excle二维图

1）选择当第一个工作薄第一个工作表

set oSheet=oExcel.Workbooks(1).Worksheets(1)

2）增加一个二维图

achart=oSheet.chartobjects.add(100,100,200,200)

3）选择二维图的形态

achart.chart.charttype=4

4）给二维图赋值

set series=achart.chart.seriescollection

range="sheet1!r2c3:r3c9"

series.add range,true

5）加上二维图的标题

achart.Chart.HasTitle=True

achart.Chart.ChartTitle.Characters.Text="Excle二维图"

6）改变二维图的标题字体大小

achart.Chart.ChartTitle.Font.size=18

7）给二维图加下标说明

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=5

achart.Chart.PlotArea.Width=223

achart.Chart.PlotArea.Height=108

如何用vbs把excel的单元格数据写到txt

复制代码代码如下:

If WScript.Arguments.Count>0Then Filename=WScript.Arguments(0)

Set a=CreateObject("Excel.Application")

If Filename=""Then

Filename=a.GetOpenFilename("Excel Files(*.xls),*.xls")

If VarType(Filename)=vbBoolean Then

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

WScript.Quit

End If

End If

Set w=a.Workbooks.Open(Filename)

n=Replace(Replace(https://www.360docs.net/doc/f82245364.html,,".xls",""),".XLS","")

a.DisplayAlerts=False

For Each s In w.Sheets

s.SaveAs w.Path&"\"&n&"_"&https://www.360docs.net/doc/f82245364.html,&".txt",20

Next

a.Quit

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

VBS操作Excel

复制代码代码如下:

Set objExcel=CreateObject("Excel.Application")'建一个exel对象

Set objWorkbook=objExcel.Workbooks.Open_

("E:\DOC\Hewl\领域模型.xls")'打开文件

strToBeWrited="-----------------------------------"&vbcrlf&_

"--Generated by ScriptGenerator---"&vbcrlf&_

"-----------------------------------"&vbcrlf&vbcrlf

Count=objWorkbook.WorkSheets.Count'取sheet数量

Set my=CreateObject("Excel.Sheet")'新建sheet对象

For Each my In objWorkbook.WorkSheets'遍历sheet

If https://www.360docs.net/doc/f82245364.html,="目录"or https://www.360docs.net/doc/f82245364.html,="SecondHandHouse"Then

'do nothing

Else

'Wscript.Echo https://www.360docs.net/doc/f82245364.html,'获得sheet名字

'Wscript.Echo my.Rows.Count

'strToBeWrited=strToBeWrited&"create table"&https://www.360docs.net/doc/f82245364.html,&vbcrlf strToBeWrited=strToBeWrited&"/*====================================== &vbcrlf

strToBeWrited=strToBeWrited&"/*Table:"&https://www.360docs.net/doc/f82245364.html,&"*/"&vbcrlf strToBeWrited=strToBeWrited&"/*====================================== &vbcrlf

strToBeWrited=strToBeWrited&"create table"&https://www.360docs.net/doc/f82245364.html,&"("&vbcrlf rowNum=3

Do Until my.Cells(rowNum,1).Value=""

'Wscript.Echo"sAMAccountName:"&my.Cells(rowNum,2).Value strToBeWrited=strToBeWrited&""&my.Cells(rowNum,2).Value&""&my not null"

If not my.Cells(rowNum,9).Value=""Then

strToBeWrited=strToBeWrited&"default"&my.Cells(rowNum,9).Value End If

strToBeWrited=strToBeWrited&","&vbcrlf

rowNum=rowNum+1

Loop

strToBeWrited=strToBeWrited&"constraint PK_"&https://www.360docs.net/doc/f82245364.html,&"primary k strToBeWrited=strToBeWrited&")"&vbcrlf

End If

strToBeWrited=strToBeWrited&vbcrlf

Next

For Each my In objWorkbook.WorkSheets'遍历sheet

If https://www.360docs.net/doc/f82245364.html,="目录"or https://www.360docs.net/doc/f82245364.html,="SecondHandHouse"Then

'do nothing

Else

strToBeWrited=strToBeWrited&"constraint PK_"&https://www.360docs.net/doc/f82245364.html,&"primary k strToBeWrited=strToBeWrited&")"&vbcrlf

End If

strToBeWrited=strToBeWrited&vbcrlf

Next

'写文件

set fs=createobject("scripting.filesystemobject")

set f=fs.opentextfile("E:\DOC\Hewl\dbscript.sql",2,true)

'Wscript.Echo strToBeWrited

f.write strToBeWrited

f.close

Set f=nothing

Set fs=nothing

objExcel.Quit'结束退出

复制代码代码如下:

Dim Excel

Set Excel=CreateObject("Excel.Application")

'不显示提示信息,这样保存的时候就不会提示是否要覆盖原文件

Excel.DisplayAlerts=FALSE

'调用EXCEL文件的时候不显示

Excel.visible=FALSE

Excel.workbooks.open("D:\test.XLS")

'将sheet1设置为活动sheet

Excel.workbooks(1).activate

'插入行,这条我找MSDN都没找到,最后乱试试出来的

Excel.ActiveSheet.rows(1).insert

Excel.ActiveSheet.Cells(1,1).Value=Date

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

Excel.ActiveSheet.Cells(1,3).Value="comment1"

Excel.ActiveSheet.rows(2).insert

Excel.ActiveSheet.Cells(2,1).Value=Date

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

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

Excel.save

Excel.quit

Set Excel=Nothing

Excel.ActiveSheet.rows(1).insert

不用找MSDN，在EXCEL帮助中就能找到，看“编程信息”/“Microsoft Excel Visual Basic 性”的介绍，和“编程信息”/“Microsoft Excel Visual Basic参考”/“方法”/“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编辑器中修改语句，调试运行无误后再粘贴

一、声明变量

Dim a as integer'声明a为整型变量

Dim a'声明a为变体变量

Dim a as string'声明a为字符串变量

Dim a as currency,b as currency,c as currency'声明a,b,c为货币变量

声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、

Decimal（当前不支持）、Date、String（只限变长字符串）、String*length

（定长字符串）、Object、Variant、用户定义类型或对象类型。

二、声明常数

ConstConst My=456'常数的默认状态是Private。

Public Const MyString="HELP"'声明Public常数。

Private Const MyInt As Integer=5'声明Private Integer常数。

Const MyStr="Hello",MyDouble As Double=3.4567'在同一行里声明多个常数。

三、行数列数

查看行数：hang=https://www.360docs.net/doc/f82245364.html,edRange.Rows.Count

EndRow=Sheets(sheetsCaption).Range(Col&"65536").End(xlUp).Row

查看列数：lie=https://www.360docs.net/doc/f82245364.html,edRange.Columns.Count

返回选定区域的行数：MsgBox Selection.Rows.Count

返回选定区域的列数：MsgBox Selection.Columns.Count

返回选定区域的地址：Selection.Address

四、赋值：

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

sheets("sheet2").select

Range("a1").value="hello"

Sheets("sheet1").Range("a1")select

ActiveCell.Value="你好！！！"

五、工作表相关：

https://www.360docs.net/doc/f82245364.html,="liu"'给活动工作表改名"liu"

Worksheets.Add'增加一个工作表

activesheet.delete'删除活动工作表

Workbooks.Open FileName:="C:\My Documents\Book2.xls"'打开一个工作簿文件ActiveWindow.Close'关闭活动窗口

With Sheets("sheet1")'设定操作区域

End With

示例：

Application.ScreenUpdating=False

Dim sheetsCaption As String:sheetsCaption="Sheet4"

Dim EndRow As Integer:EndRow=Sheets(sheetsCaption).Range("B"&

"65536").End(xlUp).Row

Dim i As Integer:i=1

With Sheets(sheetsCaption)

Do

i=i+1

Range("d"&i).Value=Range("b"&i).Value&Range("c"&i).Value Loop While i

End With

MsgBox完毕

Application.ScreenUpdating=True

六、行的操作：

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

Selection.Cut

Rows("4:4").Select

Selection.Insert Shift:=xlDown

七、单元格位移：

sub my_offset

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

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

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

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

end sub

八、单元格的设置：

Range("A5").Select'设置成红色

With Selection.Interior

.ColorIndex=3

九、报错：

如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往sub my_offset之下加一段代码on error resume next

忽略所有的错误

ON ERROR RESUME NEXT

遇错跳转：

on error goto err_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'选定单元格字体为斜体

With Selection.Font'选定单元格字体为宋体20号字

.Name="宋体"

.Size=20

End With

msgbox ActiveCell.Address'得到当前单元格的地址

msgbox date&chr(13)&time'得到当前日期及时间

十一、VBA专属特性：

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

定制自己的状态栏：Application.StatusBar="现在时刻:"&Time

恢复自己的状态栏：Application.StatusBar=false

用代码执行一个宏：Application.Run macro:="text"

滚动窗口到a1的位置：ActiveWindow.ScrollRow=1：ActiveWindow.ScrollColumn=1

定制系统日期

Dim MyDate,MyDay

MyDate=#12/12/69#

MyDay=Day(MyDate)

返回当天的时间

Dim MyDate,MyYear

MyDate=Date

MyYear=Year(MyDate)

MsgBox MyYear

inputbox<输入框>：XX=InputBox("Enter number of months to add")

得到一个文件名

Dim kk As String

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

msgbox kk

打开zoom（显示比例）对话框：Application.Dialogs(xlDialogZoom).Show

激活字体对话框：Application.Dialogs(xlDialogActiveCellFont).Show

打开另存对话框

Dim kk As String

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

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

sub my_trim

msgbox Trim(ActiveCell.Value)

end sub

保护工作簿：ActiveSheet.Protect

取消保护工作簿：ActiveSheet.Unprotect

打开一个应用程序：AppActivate(Shell("C:\WINDOWS\CALC.EXE"))

隐藏SHEET1这张工作表：sheets("sheet1").Visible=False

显示SHEET1这张工作表：sheets("sheet1").Visible=True

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

Dim my As Worksheet

For Each my In Worksheets

my.PrintPreview

Next my

相关主题
相关文档
最新文档