Dodaj nowy arkusz do istniejącego skoroszytu programu Excel z kodem VB

Question

Ten kod tworzy plik Excel z jednym arkuszem. Ten arkusz zawiera kod elementu, takiego jak (ASR/Floor/Dept./Nazwa elementu/Data_details/1), który utworzyłem i działa dobrze, ale chcę dodać arkusz do tego pliku Excel, aby utworzyć kolejny kod przedmiotu, a następnie zapisać ten plik.

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 

Answer 1

Sposób Worksheets.Add jest to, czego szukasz:

wb.WorkSheets.Add().Name = "SecondSheet" 

Zobacz MSDN (przewinąć w dół i rozwinąć Sheets and Worksheets) dla różnych parametrów można dać .Add tym mogąc dodać arkusz przed lub po konkretnym.

Answer 2

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

Answer 3

To jest jakiś standardowy kod używam do tego typu problemu Uwaga: Ten kod VBA, aby uruchomić z poziomu dokumentu Excel samego

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