投稿日 | : 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