2011-07-16 135 views
5

此代碼用一張工作表創建Excel文件。此工作表包含我創建並正常工作的項目(ASR/Floor/Dept./Item_Name/Item_details/1)的代碼,但我想在此Excel文件中添加工作表以創建另一個項目代碼,然後保存這個文件。使用VB代碼將新工作表添加到現有的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

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 
內運行
相關問題