以文本方式查看主题 - 金字塔客服中心 - 专业程序化交易软件提供商 (http://222.73.7.161/bbs/index.asp) -- 高级功能研发区 (http://222.73.7.161/bbs/list.asp?boardid=5) ---- VBA也就是EXCEL中可以通过的代码,请高人修改 (http://222.73.7.161/bbs/dispbbs.asp?boardid=5&id=618) |
-- 作者:pel46585 -- 发布时间:2010/1/5 15:43:16 -- VBA也就是EXCEL中可以通过的代码,请高人修改 Sub f() Set ws = CreateObject("wscript.shell") ws.AppActivate "1.txt" Application.SendKeys ("c") End Sub |
-- 作者:admin -- 发布时间:2010/1/5 18:40:09 -- 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).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 控制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 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 把以上代码存为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 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 \'结束退出 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 参考”/“属性”/“Q-R”/“Rows 属性”的介绍,和“编程信息”/“Microsoft Excel Visual Basic 参考”/“方法”/“I-L”/“Insert 方法”的介绍,就能明白这条语句的语法。 因为在EXCEL的VBA中,“Rows”、“Columns”、“Cells”属性返回的都是Range对象,所以对它们的应用可以等同Range对象的应用。 例如:你在EXCEL的VBA编辑器中可以这样写 cells(1,1).value="abc" cells(1,1).wraptext=false 在写这些语句时,你应该注意到,在写完“cells(1,1).”之后,并没有弹出应该弹出的属性/方法列表,但是这些语句确实可以正常运行。 我的方法是:在EXCEL中录制宏,然后在EXCEL的VBA编辑器中修改语句,调试运行无误后再粘贴到VBS语句中,进行适当的修改。 |