VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [過去ログ] [管理用]

投稿日: 2003/02/04(Tue) 09:32
投稿者marl55
URL
タイトル2度目の(Excel)シート追加ができない

以下のプログラムでCommand2で一度終了しても続けてcommand1で既存のファイルに新しいシートを作成しようとすると「実行時エラー1004 Worksheetメソッドは失敗しました。Globalオブジェクト」で"xlBook.Worksheets.Add.Move after:=Worksheets(Worksheets.Count)"の所でエラーします。(一度プログラムを終了すると問題ないのですが続けてやりたいので)解決方法を教えて下さい。(初めてで要領がわからなくてすみません)
Private Sub Command1_Click()
    'ファイルがあるかどうか調べる
    Dim MyFile As String
        MyFile = Dir("C:" & Text1.Text & ".xls")   'Text1にファイル名
        If Len(MyFile) > 1 Then
            Set xlApp = New Excel.Application
             Filename = "C:\" & Text1.Text & ".xls"
             Set xlBook = xlApp.Workbooks.Open(Filename)
             MsgBox "既存ファイルを開きます"
         Else
            Set xlApp = CreateObject("Excel.Application")
            Set xlBook = xlApp.Workbooks.Add
            Set xlSheet = xlBook.Worksheets(2)
            'xlBook.Name = Text1
            xlBook.Worksheets(2).Name = Text2.Text   'Text2にシート名
        MsgBox "新規にファイル&シートを作成します"
        End If
        
    'シートがあるかどうか調べる
    Dim Found As Integer
    Dim Sname As Worksheet
        Sheetname = Text2.Text
        Found = 0
        For Each Sname In xlBook.Worksheets      
           If Sname.Name = Text2.Text Then
                Found = 1
                MsgBox "既存シートを選択します"
                Set xlSheet = xlBook.Worksheets(Sheetname)
                Exit For
            End If
        Next
        
        If Found = 0 Then
            MsgBox "新規にシートを作成します"
            xlBook.Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
            Set xlSheet = xlBook.Worksheets(Worksheets.Count)
            xlSheet.Name = Text2.Text
        End If
        xlSheet.Select
        xlApp.Visible = True
End Sub

Private Sub Command2_Click()
    Filename = "C:\" & Text1.Text & ".xls"
    xlApp.DisplayAlerts = False
    xlSheet.SaveAs Filename  
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- Web Forum -