请问有谁用过VB控制EXCEL的WORKSHEET：增加WORKSHEET，命名WORKSHEET，在新的WORKSHEET里面输入数据，谢了

Question

Private Sub AddSheet(ByVal sSheetName As String)
    With m_oApp
        .Sheets(1).Select
        .Sheets(1).Copy After:=.Sheets(1)
        .Worksheets(2).Name = sSheetName
        Set m_oSheet = .Worksheets(2)
    End With
End SubPrivate Sub RemoveSheet(ByVal sName As String)
    With m_oApp
        .DisplayAlerts = False
        .Sheets(sName).Delete
    End With
End Sub

Answer 1

这是我的程序。你看一下喽。自己进行一下修改应该可以用的。'导出到Excel
Private Function ToExcel(rsTemp As ADODB.Recordset)
    Dim lngRowcount As Long
    Dim lngColcount As Integer
    Dim I As Long
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    On Error GoTo ErrHandler
    With rsTemp
        If .BOF And .EOF Then
            MsgBox "没有记录！", vbInformation, MessageTitle
            Exit Function
        Else
            .MoveLast
            lngRowcount = .RecordCount
            lngColcount = .Fields.Count
            .MoveFirst
        End If
    End With
    
    On Error GoTo ErrExcel
    
    If DetectExcel = True Then      '该过程检测并登记正在运行的 Excel。
        Set xlApp = GetObject(, "Excel.Application")   '如果当前系统中有excel在运行，就不必新建
    ElseIf Err.Number <> 0 Then '没有
        Set xlApp = CreateObject("Excel.Application") '创建
    End If
    Err.Clear   '清除错误
    
    On Error GoTo ErrHandler
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = False
    xlApp.ScreenUpdating = True     '提高速度
    
    With xlSheet
        .Cells(4, 2).Value = "库存号"
        .Cells(4, 3).Value = "设  备  名  称"
        .Cells(4, 4).Value = "规  格  型  号"
        .Cells(4, 5).Value = "入  库  方  式"
        .Cells(4, 6).Value = "单 价"
        .Cells(4, 7).Value = "数 量"
        .Cells(4, 8).Value = "金 额"
        .Cells(4, 9).Value = "生  产  厂  家"
        .Cells(4, 10).Value = "设  备  类  型"
        .Cells(4, 11).Value = "使用部门"
        .Cells(4, 12).Value = "经 办 人"
        .Cells(4, 13).Value = "保 管 员"
        .Cells(4, 14).Value = "购 买 日 期"
        .Cells(4, 15).Value = "入 库 日 期"
        .Cells(4, 16).Value = "备       注"
        
        .Range(.Cells(1, 1), .Cells(1, lngColcount)).Font.Name = "宋体"
        '设标题为宋体字
        .Range(.Cells(1, 1), .Cells(1, lngColcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(lngRowcount + 1, lngColcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
        For I = 1 To lngRowcount            '填写内容
            .Cells(I + 4, 2).Value = Trim(rsTemp.Fields("EquipNo"))
            .Cells(I + 4, 3).Value = Trim(rsTemp.Fields("EquipName"))
            .Cells(I + 4, 4).Value = Trim(rsTemp.Fields("EquipModal"))
            .Cells(I + 4, 5).Value = Trim(rsTemp.Fields("Detail"))
            .Cells(I + 4, 6).Value = Trim(rsTemp.Fields("EquipPrice"))
            .Cells(I + 4, 7).Value = Trim(rsTemp.Fields("EquipAmount"))
            .Cells(I + 4, 8).Value = Trim(rsTemp.Fields("MoneyCount"))
            .Cells(I + 4, 9).Value = Trim(rsTemp.Fields("EquipFac"))
            .Cells(I + 4, 10).Value = Trim(rsTemp.Fields("EquipName1"))
            .Cells(I + 4, 11).Value = Trim(rsTemp.Fields("DeptName"))
            .Cells(I + 4, 12).Value = Trim(rsTemp.Fields("UserName"))
            .Cells(I + 4, 13).Value = Trim(rsTemp.Fields("UserKeep"))
            .Cells(I + 4, 14).Value = Format(Trim(rsTemp.Fields("BuyDate")), "yyy年mm月dd日")
            .Cells(I + 4, 15).Value = Format(Trim(rsTemp.Fields("InstockDate")), "yyy年mm月dd日")
            .Cells(I + 4, 16).Value = Trim(rsTemp.Fields("UserDetail"))
            rsTemp.MoveNext
        Next
    End With
    
     '设置题头和注脚
    On Error Resume Next
    With xlSheet.PageSetup
        .CenterHeader = "&""黑体_GB2312,加粗""&18固定资产报表"
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人："
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期：&D"
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    On Error GoTo 0
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = Nothing    Exit Function
ErrHandler:
    MsgBox "导出数据初始化错误！请与系统管理员联系！", vbInformation, MessageTitle
    Exit Function
ErrExcel:
    MsgBox "请先行安装Excel！", vbInformation, MessageTitle
    Exit Function
End Function

Answer 2

我的方法一般用于复制模板
当然你也可以新建WORKSHEET,但是新建的没有格式