| 投稿日 | ： 2003/02/04(Tue) 10:46 |
| 投稿者 | ： A221 |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re: 2度目の(Excel)シート追加ができない |
では、１つずつ行きます。
> Private Sub Command1_Click()
> 'ファイルがあるかどうか調べる
> Dim MyFile As String
> MyFile = Dir("C:" & Text1.Text & ".xls") 'Text1にファイル名
MyFile = Dir("C:\" 〜
> 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.Worksheets(2).Name = Text2.Text 'Text2にシート名
> MsgBox "新規にファイル&シートを作成します"
> End If
>
> 'シートがあるかどうか調べる
> Dim Found As Integer
Booleanで判別するほうが簡潔でよいのでは？
> 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)
.Add と.Moveは同時に出来ないですね。
また、after:=Worksheets(Worksheets.Count)の部分は、
after:=xlbook.Worksheets(xlbook.Worksheets.Count)と指定せねばならないでしょう。
> Set xlSheet = xlBook.Worksheets(Worksheets.Count)
Set xlSheet = xlBook.Worksheets(xlBook.Worksheets.Count)
> xlSheet.Name = Text2.Text
> End If
> xlSheet.Select
> xlApp.Visible = True
> End Sub
ちなみに、私が評価しながら作り変えてみたのは以下のようになりました。
Command2のほうは評価していません
'-------------------------------------------------------
Option Explicit
Private xlApp As New Excel.Application
Private xlBook As New Excel.Workbook
Private xlSheet As New Excel.Worksheet
Private Filename As String
Private Sub Command1_Click()
'ファイルがあるかどうか調べる
Dim FoundFlag As Boolean
Dim tmpSheet As Excel.Worksheet
Dim MyFile As String
Filename = "C:\" & Text1.Text & ".xls"
MyFile = Dir(Filename) 'Text1にファイル名
If Len(MyFile) > 1 Then
MsgBox "既存ファイルを開きます"
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open(Filename)
'シートがあるかどうか調べる
For Each tmpSheet In xlBook.Worksheets
If tmpSheet.Name = Text2.Text Then
FoundFlag = True
Set xlSheet = tmpSheet
Exit For
End If
Next
If Not (FoundFlag) Then
MsgBox "新規にシートを作成します"
xlBook.Worksheets.Add
xlBook.ActiveSheet.Move After:=xlBook.Worksheets(xlBook.Worksheets.Count)
Set xlSheet = xlBook.Worksheets(Worksheets.Count)
xlSheet.Name = Text2.Text
Else
MsgBox "既存シートを選択します"
End If
Else
MsgBox "新規にファイル&シートを作成します"
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Name = Text2.Text
End If
xlSheet.Select
xlApp.Visible = True
End Sub