如何用vb6编程实现EXCEL单元格的合并?????

Question

如何用vb6编程实现EXCEL单元格的合并?????

Answer 1

Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)    With Rs_Dzgl_Receipt
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Sub
        End If
        xlSheet.Cells(1, 4).Value = .Fields("bt")
        xlSheet.Cells(2, 1).Value = .Fields("invoice")
        xlSheet.Cells(2, 9).Value = .Fields("packdate")
        xlSheet.Cells(3, 1).Value = .Fields("")
                        
        '合并单元格
        Dim nIcol As Integer
        
        xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(5, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With
            
        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With
        '网格线
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Name = "黑体"
            '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Bold = True
            '标题字体加粗
            .Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous
            '设表格边框样式
        End With
        
        '显示表格
        Dim ExclFileName As String
        ExclFileName = App.Path & "\箱单" & Text1(1).Text & ".xls"
        If Dir(ExclFileName) <> "" Then
            Kill ExclFileName
        End If
        xlSheet.SaveAs (ExclFileName)
        xlApp.Application.Visible = True
        '交还控制给Excel
        xlSheet.PrintPreview
       ' xlApp.Application.Quit
       ' xlApp.Quit
    End With

Answer 2

Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)    With Rs_Dzgl_Receipt
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Sub
        End If
        xlSheet.Cells(1, 4).Value = .Fields("bt")

Answer 3

Dim xlApp As new Excel.Application
    xlapp.visible=true'启动excel
    xlapp.workbooks.add()'新建sheet
    xlapp.arange("A1:E:").MergeCells = True'合并
    
搞定
xlapp.activeworkbook.close(true,savefilename)'保存文件
xlapp.quit'退出
set xlapp=nothing