2011-07-16 91 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 
内运行
相关问题