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

投稿日: 2003/02/04(Tue) 10:46
投稿者A221
Eメール
URL
タイトルRe: 2度目の(Excel)シート追加ができない

では、1つずつ行きます。

> 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)

ここで新規の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


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

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

- Web Forum -