【VB】VB操作Excel相关处理

Option Explicit
Dim xlapp As Excel.Application 'Excel对象
Dim xlbook As Excel.Workbook '工作簿
Dim xlsheet As Excel.Worksheet '工作表
Dim xlChart As Excel.Chart     ' Excel Chart
'我们打算做的是:打开/新建一个excel,在其中对某工作表的一些单元格修改其值,然后另存为test.xls文件。
Private Sub Excel_Out_Click()
    Dim i, j As Integer
    Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
    'Set xlbook = xlapp.Workbooks.Open(App.Path & "\test.xls") '打开已经存在的test.xls工件簿文件
    Set xlbook = xlapp.Workbooks.Add '新建EXCEL工件簿文件
    'xlbook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏
    'xlbook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏
   
    xlapp.Visible = True '设置EXCEL对象可见(或不可见)
    xlapp.Caption = "VB打开Excel"
   
    Set xlsheet = xlbook.Worksheets(1) '设置活动工作表''
    ''~~~当前工作簿的第一页,这里也可以换成“表名”
   
    xlsheet.Range(Cells(6, 1), Cells(6, 10)).Merge '合并a1:b2单元格
    xlsheet.Cells(6, 1) = "合并单元格"
   
    '居中显示
    xlsheet.Range("A6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
   
    '下面就是简单的在一些单元格内写入数字
    For i = 7 To 15
        For j = 1 To 10
            xlsheet.Cells(i, j) = j   '当前工作簿第一页的第I行第J列
'            xlsheet.Cells(i, j).Interior.ColorIndex = j '设置背景颜色
            xlsheet.Cells(i, j).Font.Color = vbRed
        Next j
        xlsheet.Rows(i).RowHeight = (i Mod 2 + 1) * 1 / 0.035 '设置指定行的高度(单位:磅) (设定行高为1厘米,1磅=0.035厘米)
        If i = 10 Or i = 14 Then
            xlsheet.Rows(i).PageBreak = 1 '在第10和14行之前插入分页符
        End If
    Next i
   
      xlsheet.Columns(4).PageBreak = 0 '在第4列之前删除分页符
   
    For j = 1 To 10
        xlsheet.Columns(j).ColumnWidth = j '设置指定列的宽度(单位:字符个数)
    Next j
   
   
    xlsheet.Range("b3:d3").Borders(2).Weight = 3 '指定边框线宽度 (Borders参数如下)
    '(其中Borders参数:1-左、2-右、3-顶、4-底、5-斜、6-斜/)
    xlsheet.Range("b3:d3").Borders(2).LineStyle = 1 '设置四个边框线条的类型
    '(LineStyle值:1与7-细实、2-细虚、4-点虚、9-双细实线)
   
   
    With xlsheet      '设置边框为是实线
        .Range(.Cells(7, 1), .Cells(15, 10)).Borders.LineStyle = xlContinuous
    End With
   
    Set xlChart = xlsheet.ChartObjects.Add(0, 0, 300, 200).Chart
    xlChart.SetSourceData xlsheet.Range(xlsheet.Cells(7, 1), xlsheet.Cells(15, 10)).Resize(9, 10)
    xlsheet.PageSetup.CenterHeader = "报表1" '设置页眉
   
    '设置页脚
    xlsheet.PageSetup.CenterFooter = "第&P页"
   
    '设置页眉到顶端边距为2厘米
    xlsheet.PageSetup.HeaderMargin = 2 / 0.035
    '设置页脚到底边距为3厘米
    xlsheet.PageSetup.FooterMargin = 3 / 0.035
    '设置顶边距为2厘米
    xlsheet.PageSetup.TopMargin = 2 / 0.035
    '设置底边距为4厘米
    xlsheet.PageSetup.BottomMargin = 4 / 0.035
    '.设置左边距为2厘米
    xlsheet.PageSetup.LeftMargin = 2 / 0.035
    '.设置右边距为2厘米
    xlsheet.PageSetup.RightMargin = 2 / 0.035
    '.设置页面水平居中
    xlsheet.PageSetup.CenterHorizontally = True
    '.设置页面垂直居中
    xlsheet.PageSetup.CenterVertically = True
    '.设置页面纸张大小(1-窄行8511   39-宽行1411)
    xlsheet.PageSetup.PaperSize = 1
    '.打印单元格网线
    xlsheet.PageSetup.PrintGridlines = True
    '.拷贝整个工作表
    xlsheet.UsedRange.Copy
    '.拷贝指定区域
    xlsheet.Range("A1:E2").Copy
    '.粘贴
    xlbook.Worksheets("Sheet2").Range("A1").PasteSpecial
    '.在第2行之前插入一行
    xlsheet.Rows(2).Insert
    '.在第2列之前插入一列
    xlsheet.Columns(2).Insert
    '.设置字体
    xlsheet.Cells(2, 1).Font.Name = "黑体"
    '.设置字体大小
    xlsheet.Cells(1, 1).Font.Size = 25
    '.设置字体为斜体
    xlsheet.Cells(1, 1).Font.Italic = True
    '.设置整列字体为粗体
    xlsheet.Columns(1).Font.Bold = True
    '.清除单元格公式
    xlsheet.Cells(1, 4).ClearContents
'    '.打印预览工作表
'    xlsheet.PrintPreview
'    '.打印输出工作表
'    xlsheet.PrintOut

    '引用当前工作簿的第二页
    Set xlsheet = xlapp.Application.Worksheets(2)
    xlsheet.Cells(7, 2) = 2008   '在第二页的第7行第2列写入2008
    If Dir(App.Path & "\test.xls") <> "" Then
        If MsgBox(App.Path & "\test.xls 已存在,是否要替换?", vbQuestion + vbYesNo, "提示信息") = vbYes Then
            Kill App.Path & "\test.xls"
            xlsheet.SaveAs App.Path & "\test.xls"           '按指定文件名存盘
        Else
          
        End If
    Else
        xlsheet.SaveAs App.Path & "\test.xls"
    End If
   
    'Set xlbook = xlapp.Application.Workbooks.Add '新建一空白工作簿
   
    xlbook.Close (True)
    xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.Close
   
    Set xlapp = Nothing '释放xlApp对象
End Sub
 

相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页