系列文章分类

C#专栏、VBS专栏、JAVA 专栏、IDEA 专栏

前言

提示：以下是本篇文章正文内容，下面案例可供参考

一、实现代码

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("UserAccounts.CommonDialog") 
objFileDlg.Filter = "Excel File (*.xls) |*.xls" 
If objFileDlg.ShowOpen Then 
msgbox "您选择的文件是：" & objFileDlg.FileName & vbCrLf 
End If 

二、实现代码

(一) 使用动态创建的方法 
首先创建 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).Font.Name = "隶书" 
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.拷贝整个工作表： 
oExcel.ActiveSheet.Used.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把excel的单元格数据写到txt

 
If WScript.Arguments.Count > 0 Then 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 & vbLf & vbCr & vbLf & "用法: Excel2Txt filename.xls 或在对话框中打开Excel文件。" 
WScript.Quit 
End If 
End If 
Set w = a.Workbooks.Open(Filename) 
n = Replace(Replace(w.Name, ".xls", ""), ".XLS", "") 
a.DisplayAlerts = False 
For Each s In w.Sheets 
s.SaveAs w.Path & "\" & n & "_" & s.Name & ".txt", 20 
Next 
a.Quit 

改后缀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 my.Name = "目录" or my.Name = "SecondHandHouse" Then 
'do nothing 
Else 
'Wscript.Echo my.Name '获得sheet名字 
'Wscript.Echo my.Rows.Count 
'strToBeWrited = strToBeWrited & "create table " & my.Name & vbcrlf 
strToBeWrited = strToBeWrited & "/*==============================================================*/" & vbcrlf 
strToBeWrited = strToBeWrited & "/* Table: " & my.Name & " */" & vbcrlf 
strToBeWrited = strToBeWrited & "/*==============================================================*/" & vbcrlf 
strToBeWrited = strToBeWrited & "create table " & my.Name & " (" & 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.Cells(rowNum,3).Value & " 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_" & my.Name & " primary key (id)" & vbcrlf 
strToBeWrited = strToBeWrited & ")" & vbcrlf 
End If 
strToBeWrited = strToBeWrited & vbcrlf 
Next 
For Each my In objWorkbook.WorkSheets '遍历sheet 
If my.Name = "目录" or my.Name = "SecondHandHouse" Then 
'do nothing 
Else 

strToBeWrited = strToBeWrited & " constraint PK_" & my.Name & " primary key (id)" & vbcrlf 
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 '结束退出 

总结

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