使用VB代码向现有的Excel工作簿添加新的工作表

5
这段代码创建了一个包含一个工作表的Excel文件。该工作表包含一个条目的代码(如ASR/Floor/Dept./Item_Name/Item_details/1),我已经创建并且可以正常工作,但是我想在这个Excel文件中添加另一个工作表来创建另一个条目代码,然后保存该文件。
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim var As Variant
Dim code As String
Dim i, nocode As Integer
Dim fname, heading As String

code = "ASR/" & Text1.Text & "/" & Text2.Text & "/" & Text3.Text & "/" & Text4.Text

Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Add ' Create a new WorkBook
Set ws = wb.Worksheets("Sheet1") 'Specify your worksheet name

nocode = txtnocode.Text
heading = Text6.Text

For i = 2 To nocode + 1
  ws.Cells(i, 1).Value = code & "/" & i - 1 '"ORG"
Next i

fname = "c:\" & Text5.Text & ".xls"

wb.SaveAs (fname)
wb.Close
xlApp.Quit

Set ws = Nothing
Set wb = Nothing
Set xlApp = Nothing
3个回答

3
您需要使用Worksheets.Add方法:
wb.WorkSheets.Add().Name = "SecondSheet"

请查看MSDN(向下滚动并展开Sheets and Worksheets),了解可以提供给.Add的不同参数,包括在特定表单之前或之后添加表单的能力。


0
Set ws = wb.Sheets("Sheet1") 
Set ws = wb.Sheets.Add
ws.Activate

0

这是我在处理这种类型的问题时使用的一些标准代码。 注意:此代码为VBA代码,需要在Excel文档内运行。

 Option Explicit

Private m_sNameOfOutPutWorkSheet_1 As String


Sub Delete_Recreate_TheWorkSheet()

    On Error GoTo ErrorHandler

    '=========================
    Dim strInFrontOfSheetName As String
    m_sNameOfOutPutWorkSheet_1 = "Dashboard_1"
    strInFrontOfSheetName = "CONTROL"    'create the new worksheet in front of this sheet

    '1] Clean up old data if it is still there
    GetRidOf_WorkSheet_IfItExists (m_sNameOfOutPutWorkSheet_1)

    CreateNewOutputWorkSheet m_sNameOfOutPutWorkSheet_1, strInFrontOfSheetName
    'Color the tab of the new worksheet
    ActiveWorkbook.Sheets(m_sNameOfOutPutWorkSheet_1).Tab.ColorIndex = 5

    'Select the worksheet that I started with
    Worksheets(strInFrontOfSheetName).Select

    '=========================
      Exit Sub

ErrorHandler:
        Select Case Err.Number
            Case Else
                MsgBox "One_Main - Error: " & Err.Number & " " & Err.Description
        End Select
 End Sub

Sub GetRidOf_WorkSheet_IfItExists(sWorkSheetName_ForInitalData As String)
    On Error GoTo ErrorHandler

    '=========================

    If fn_WorkSheetExists(sWorkSheetName_ForInitalData) Then
        'Sheet Exists
        Application.DisplayAlerts = False
        Worksheets(sWorkSheetName_ForInitalData).Delete
        Application.DisplayAlerts = True

    End If

    '=========================
      Exit Sub

ErrorHandler:
        Select Case Err.Number
            Case Else
                MsgBox "GetRidOf_WorkSheet_IfItExists - Error: " & Err.Number & " " & Err.Description
        End Select
    End Sub


Function fn_WorkSheetExists(wsName As String) As Boolean
    On Error Resume Next
    fn_WorkSheetExists = Worksheets(wsName).Name = wsName
End Function


Sub CreateNewOutputWorkSheet(sWorkSheetName_ForOutputData As String, strInFrontOfSheetName As String)
    On Error GoTo ErrorHandler

    '=========================
    If fn_WorkSheetExists(sWorkSheetName_ForOutputData) Then
        'Sheet Exists
        Application.DisplayAlerts = False
        Worksheets(sWorkSheetName_ForOutputData).Delete
        Application.DisplayAlerts = True
    End If

    Dim wsX As Worksheet
    Set wsX = Sheets.Add(Before:=Worksheets(strInFrontOfSheetName))

    wsX.Name = sWorkSheetName_ForOutputData

    '=========================
      Exit Sub

ErrorHandler:
        Select Case Err.Number
            Case Else
                MsgBox "CreateNewOutputWorkSheet - Error: " & Err.Number & " " & Err.Description
        End Select
End Sub

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接