Excel VBS编程技巧

Sub xjdx()    Dim FileName, SheetName, Text, ExcelApp, ExcelBook, ExcelSheet        FileName = "D:/Book1.xls"    SheetName = "新建表"    Text = "Hello QTP ! 你好, QuickTestProfessional !"    Set ExcelApp = CreateObject("Excel.Application")    Set ExcelBook = ExcelApp.Workbooks.Open(FileName)    Set ExcelSheet = ExcelBook.Sheets.Add '插入工作表    Set ExcelSheet = ExcelBook.Sheets.Item(SheetName) '获得指定工作表    Set sSheet = ActiveWorkbook.Sheets("原始数据") '获得活动工作表    sSheet.Activate '使某工作表活动    Cells.Clear '清楚表格内容和数据    Cells.ClearContents    n = inputSheet.UsedRange.Rows.Count '获得活动行数    ' *************** 对数据表的操作 ***************    For i = 1 To ExcelBook.Sheets.Count        If ExcelBook.Sheets(i).Name = SheetName Then            ExcelApp.DisplayAlerts = False            ExcelBook.Sheets(i).Delete '删除工作表            ExcelApp.DisplayAlerts = True            Exit For        End If    Next    ExcelSheet.Name = SheetName '重命名工作表    ' *************** 对文字的操作 ***************    ExcelSheet.Cells(1, 2) = Text    ExcelSheet.Range("B2", "B20").Value = Text    ExcelSheet.Cells(1, 2).Font.Name = "Verdana" '设置字体    ExcelSheet.Cells(1, 2).Font.Size = 25 '设置字号    ExcelSheet.Cells(1, 2).Font.Color = RGB(0, 0, 255) '设置字体颜色    ExcelSheet.Cells(2, 2).Font.Bold = True '文字加粗    ExcelSheet.Cells(3, 2).Font.Italic = True '文字倾斜    ExcelSheet.Cells(4, 2).Font.Underline = True '文字加下划线    ExcelSheet.Cells(5, 2).Font.Strikethrough = True '文字加删除线    ExcelSheet.Cells(6, 2).Characters(2, 2).Font.Superscript = True '设定文字上标    ExcelSheet.Cells(7, 2).Characters(2, 2).Font.Subscript = True '设定文字下标   ' *************** 对单元格的操作 ***************    ExcelSheet.Columns("B").ColumnWidth = 40 '设置列宽    ExcelSheet.Columns("B").AutoFit '自动调整列宽    ExcelSheet.Range("B11").RowHeight = 40 '设置行高    ExcelSheet.Rows(11).Rows.AutoFit '自动调整行高    ExcelSheet.Range("B8", "D8").Merge '合并单元格，水平方向     ExcelSheet.Range("B18", "B19").Merge '合并单元格，垂直方向    ExcelSheet.Range("B8", "D8").Borders.Color = RGB(0, 255, 0) '设定单元格边框颜色    ExcelSheet.Range("B12").Interior.Color = RGB(255, 0, 0) '设置单元格背景色    ExcelSheet.Cells(9, 2).WrapText = True '自动换行    ExcelSheet.Cells(10, 2).HorizontalAlignment = 3 '设置水平对齐，1常规，2靠左，3居中，4靠右    ' 5填充，6两端对齐，7跨列居中，8分散对齐    ExcelSheet.Cells(11, 2).VerticalAlignment = 1 '设置垂直对齐，1靠上，2居中，3靠下    ' 4两端对齐，5分散对齐    ExcelSheet.Range("B14").Borders(1).LineStyle = 1 '设置左边框样式    ExcelSheet.Range("B14").Borders(2).LineStyle = 2 '设置右边框样式    ExcelSheet.Range("B14").Borders(3).LineStyle = 3 '设置上边框样式    ExcelSheet.Range("B14").Borders(4).LineStyle = 4 '设置下边框样式    ExcelSheet.Range("B15").ClearContents '清除单元格内容    ExcelSheet.Range("B16").Formula = "=1+10" '设置单元格公式    ExcelSheet.Range("B17").AddComment ("Hello" & vbLf & "QTP") '插入批注    ExcelSheet.Range("B17").Comment.Visible = True '显示批注    ExcelSheet.Range("B17").ClearComments '清除批注，与删除批注效果相同    ExcelSheet.Range("B17").Comment.Delete '删除批注，与清除批注效果相同    ExcelSheet.SaveAs("D:\Book2.xls") '另存为    ExcelBook.Save    ExcelBook.Close    ExcelApp.Quit    Set ExcelBook = Nothing    Set ExcelApp = Nothing    SystemUtil.CloseProcessByName "Excel.exe" '如果仍有Excel.exe进程，可使用这句关闭进程    If Err.Number > 0 Then    MsgBox Err.Description    End If        ExcelApp.DisplayAlerts = False ‘关闭兼容性检查    ExcelBook = ExcelApp.Workbooks.Add ‘新建Excel    ExcelSheet = ExcelBook.ActiveSheet ‘激活第一个表    ExcelSheet.Columns(“A:E”).AutoFit() ‘设置A到E列自动调整列宽    ExcelBook.SaveAs(“D:\Book2.xls”,FileFormat:=Excel.XLFileFormat.xlAddIn) ‘文件另存为End SubFunction trimL(ByVal s As String)    Do While (Left(s, 1) = " ")        s = Right(s, Len(s) - 1)    Loop    trimL = sEnd FunctionFunction trimR(ByVal s As String)    Do While (Right(s, 1) = " ")        s = Left(s, Len(s) - 1)    Loop    trimR = sEnd FunctionFunction trim(ByVal s As String)    trim = trimR(trimL(s))End Function  Sub SaveUTF8(ByVal Text As String, ByVal FileName As String)    Dim oStream             As ADODB.Stream     Set oStream = New ADODB.Stream    oStream.Open    oStream.Charset = "UTF-8"    oStream.Type = adTypeText    oStream.WriteText Text    oStream.SaveToFile FileName, adSaveCreateOverWrite    oStream.CloseEnd Sub Function LoadUTF8(ByVal FileName As String)    Dim oStream     As ADODB.Stream         Set oStream = New ADODB.Stream    oStream.Open    oStream.Charset = "UTF-8"    oStream.LoadFromFile FileName         LoadUTF8 = oStream.ReadText()         oStream.CloseEnd Function '调用很简单'Private Sub Command2_Click()    Dim s As String         s = LoadUTF8("D:\ansoft\yang\script1.vbs")    s = Replace(s, "磁芯外半径", Text1.Text)    SaveUTF8 s, "D:\ansoft\yang\script1.vbs"End Sub  Pirvate Sub Sub1() 'C:\Data.exe 到 C:\Data.txt    Open "C:\Data.exe" For Binary As #1    Open "C:\Data.txt" For Binary As #2    Dim i As Byte    Do While Not EOF(1)        Get #1, , i        Put #2, , i    Loop    Close #1    Close #2End Sub函数 CInt() Integer CLng() Long CSng() Single CBbl() Double     '类型转换'vbs中的structType dmT    je As Long    dm As LongEnd Type  'Type 不能在对象模板中定义 所以必须插入一个公共模块定义  并且要使用public关键字定义Public Type dmT    je As Long    dm As LongEnd Type' 设置 单元格 格式Range("a1").Select  '选定单元格Selection.NumberFormatLocal = "0.00_ "          '这是设成2位小数  最后必须要有一个空格Selection.NumberFormatLocal = "0.00% "          '这是设成2位百分比Selection.NumberFormatLocal = "0%"               '这是设成整百分百小数

'VB函数缺省Function f(ByVal Param1 As Long, Optional ByVal Param As Long = 10) As Long

vb中如何判断变量的数据类型

TypeName 函数 返回一个 String，提供有关变量的信息。语法TypeName(varname)必要的 varname 参数是一个 Variant，它包含用户定义类型变量之外的任何变量。说明TypeName 所返回的字符串可以是下面列举的任何一个字符串：返回字符串变量对象类型类型为 objecttype 的对象Byte位值Integer整数Long长整数Single单精度浮点数Double双精度浮点数Currency货币Decimal十进制值 Date日期String字符串布尔布尔值Error错误值Empty未初始化Null无效数据Object对象Unknown类型未知的对象 Nothing不再引用对象的对象变量如果 varname 是一个数组，则返回的字符串可以是任何一个后面添加了空括号的可能的返回字符串（或 Variant）。例如，如果 varname 是一个整数数组，则 TypeName 返回 "Integer()"。