VBからExcelを起動し、データベースから取得した値を設定しています。

ファイルが存在しない場合は、新規作成し、既存のファイルが存在する
場合は、既存のファイルを開き、シートを新しく追加して設定します。

新規作成は、上手く動いているみたいです。
ここで、追加するファイルが既に存在する場合、
また、追加するシートが必ず一番左側に作られてしまいます。
存在しているシートの一番後（一番右側）に作りたいのです。

また、同じシートが存在した場合、シートをコピーしたようなかたち、
つまり「(2)、(3)・・・」をつけて作成したいのです。

以下の様に作ってみたのですが、どうしても、一番右側にシートが
作られてしまいますし、上手く保存ができません。

どうすればよいか教えてください。
また、新規作成についてもどこかおかしいところがありましたら
ご指摘下さい。


--- ソースコード（抜粋）

Private Function Excel_set(objDs As Object,Sheet_name As String) As Boolean
    Dim Fso As FileSystemObject
    Dim xlApp   As Excel.Application
    Dim xlBook  As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim FileDir As String
    Dim strToday As String
    Dim strExcelFile As String
    Dim strExcelSheet As String
    Dim RowCnt As Integer
    Dim ColCnt As Integer
    Dim I As Integer

On Error GoTo ErrHandle
    Excel_set = True

    FileDir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.FolderExists(FileDir) = False Then
        Fso.CreateFolder FileDir
    End If

    strToday = Year(Date) & Format(Month(Date), "0#") & Format(Day(Date), "0#")
    strExcelFile = FileDir & "\" & "file_" & strToday & ".xls"
    strExcelSheet = Sheet_name

    Set xlApp = CreateObject("Excel.Application")
    If Fso.FileExists(strExcelFile) = True Then
        Set xlBook = xlApp.Workbooks.Open(strExcelFile)
        Set xlSheet = xlBook.Worksheets.Add
        Set xlSheet = xlBook.Worksheets(xlBook.Worksheets.Count)
    Else
        Set xlBook = xlApp.Workbooks.Add
        Set xlSheet = xlBook.Worksheets(1)
    End If

    xlApp.Visible = False
    xlSheet.Activate

    DoEvents

    '見出し作成
    xlSheet.Cells.NumberFormat = "@"
    ColCnt = 17
    With xlSheet
      :
    End With

    'データ設定
    I = 2
    Do Until objDs.EOF
        With xlSheet
          :

        End With

        I = I + 1
        objDs.DbMoveNext
    Loop
    RowCnt = I - 1

    '書式設定

    xlApp.DisplayAlerts = False
    xlSheet.Name = strExcelSheet
    xlBook.SaveAs strExcelFile
    xlBook.Close
    xlApp.Quit

    If Fso.FileExists(strExcelFile) = False Then
        Excel_set = False
    Else
        MsgBox strExcelFile & Chr(13) & Chr(10) & "に作成しました。"
    End If

    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Set Fso = Nothing

    Exit Function

ErrHandle:
    エラー処理
    Excel_set = False

    xlBook.Close
    xlApp.Quit

    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Set Fso = Nothing
End Function

> また、追加するシートが必ず一番左側に作られてしまいます。
> 存在しているシートの一番後（一番右側）に作りたいのです。

必ず一番左側に作られてしまうのなら
作った後でそれを一番右側に移動させてあげればいいのでは？
ダイレクトに一番右側に作らないといけない事情でもあるのでしたらごめんなさい。

> VBからExcelを起動し、データベースから取得した値を設定しています。

> ここで、追加するファイルが既に存在する場合、
> また、追加するシートが必ず一番左側に作られてしまいます。
> 存在しているシートの一番後（一番右側）に作りたいのです。

        Set xlSheet = xlBook.Worksheets.Add
        Set xlSheet = xlBook.Worksheets(xlBook.Worksheets.Count)
　　上記2行を下記のようにすれば一番右側にセットできます。
　　エクセルのヘルプも読みましょう。

    Set xlSheet = xlBook.Worksheets.Add(after:=Worksheets(Worksheets.Count))

> Set xlSheet = xlBook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
そうではなく、
  Set xlSheet = xlBook.Worksheets.Add(after:=xlBook.Worksheets(xlBook.Worksheets.Count))
なのでは。

> そうではなく、
>   Set xlSheet = xlBook.Worksheets.Add(after:=xlBook.Worksheets(xlBook.Worksheets.Count))
> なのでは。

そうですね。親オブジェクトが抜けていました。
有難う御座います。

ありがとうございます。
期待した動きをしました。

エクセルのヘルプまでは調べていませんでした。
VBのヘルプばかりで探していました。
「.Activate」、「.Select」の意味、使い方などもエクセルのヘルプでしょうか。

また、以下のでも動きました。
-----
xlBook.Worksheets.Add
xlBook.ActiveSheet.Move After:=xlBook.Worksheets(xlBook.Worksheets.Count)
Set xlSheet = xlBook.Worksheets(xlBook.Worksheets.Count)
-----


教えて頂いた、シートの追加で、画面を終了させずに、連続してシートの追加
（Excelへのデータの設定）を行ったのですが、２回以降は、エラーが発生して
してしまいます。

Set xlBook = xlApp.Workbooks.Open(strExcelFile)
Set xlSheet = xlBook.Worksheets.Add(after:=Worksheets(xlBook.Worksheets.Count))

以下の様なエラーが発生します。
「アプリケーション定義またはオブジェクト定義のエラーです。」
また、タスクマネージャのプロセス欄からExcel.exe が消えてくれません。

どこがいけないのでしょうか。


-----
Private Function Excel_set(objDs As Object, obj_date As String) As Boolean
    Dim Fso As FileSystemObject
    Dim xlApp   As Excel.Application
    Dim xlBook  As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim ws      As Excel.Worksheet

    Dim FileDir As String
    Dim strToday As String
    Dim strExcelFile As String
    Dim strExcelSheet As String
    Dim tmpSheet As String
    Dim wsCnt As Integer
    Dim RowCnt As Integer
    Dim ColCnt As Integer
    Dim I As Integer

On Error GoTo ErrHandle
    Excel_set = True

    FileDir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.FolderExists(FileDir) = False Then
        Fso.CreateFolder FileDir
    End If

    strToday = Year(Date) & Format(Month(Date), "0#") & Format(Day(Date), "0#")
    strExcelFile = FileDir & "\" & "file_" & strToday & ".xls"
    strExcelSheet = obj_date

    Set xlApp = CreateObject("Excel.Application")
    If Fso.FileExists(strExcelFile) = True Then
        Set xlBook = xlApp.Workbooks.Open(strExcelFile)
        Set xlSheet = xlBook.Worksheets.Add(after:=Worksheets(xlBook.Worksheets.Count))
    Else
        Set xlBook = xlApp.Workbooks.Add
        Set xlSheet = xlBook.Worksheets(1)
    End If

    wsCnt = 0
    For Each ws In xlBook.Worksheets
        tmpSheet = ws.Name
        If InStrB(1, tmpSheet, strExcelSheet, -1) <> 0 Then
            wsCnt = wsCnt + 1
        End If
    Next
    If wsCnt <> 0 Then
        strExcelSheet = strExcelSheet & " (" & wsCnt + 1 & ")"
    End If

    xlApp.Visible = False
    xlSheet.Activate

    DoEvents

    '見出し設定
    xlSheet.Cells.NumberFormat = "@"
    ColCnt = 17
    With xlSheet
    End With

    'データ設定
    I = 2
    Do Until objDs.EOF
        With xlSheet
        End With

        I = I + 1
        objDs.DbMoveNext
    Loop
    RowCnt = I - 1

    '書式設定
    With xlSheet
    End With

    xlApp.DisplayAlerts = False
    xlSheet.Name = strExcelSheet
    xlBook.SaveAs strExcelFile
    xlBook.Close
    xlApp.Quit

    If Fso.FileExists(strExcelFile) = False Then
        Excel_set = False
    Else
        MsgBox strExcelFile & Chr(13) & Chr(10) & "に作成しました。"
    End If

    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Set Fso = Nothing

    Exit Function

ErrHandle:
    エラー処理
    Excel_set = False

    xlBook.Close
    xlApp.Quit

    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Set Fso = Nothing
End Function
-----

> 「.Activate」、「.Select」の意味、使い方などもエクセルのヘルプでしょうか。
ですね。正確には Excel 本体のヘルプでは無く、「Excel VBA」のヘルプですけれども。


> xlBook.Worksheets.Add
> xlBook.ActiveSheet.Move After:=xlBook.Worksheets(xlBook.Worksheets.Count)
追加してから移動する方法ですね。それでも良いと思います。

ただし、シートの Move は、ウィンドウが非表示の場合などには使えないので、
YK さんが提示されたように、Add 時に位置を指定する方が安全かつ効率的です。

それと、このような場合に ActiveSheet プロパティを使う事はあまりお薦めできません。
　Set foo = xlBook.Worksheets.Add()
　foo.Move After:=……
のように、操作対象のシートを明示した方が良いでしょう。


> 教えて頂いた、シートの追加で、画面を終了させずに、連続してシートの追加
> （Excelへのデータの設定）を行ったのですが、２回以降は、エラーが発生して
> してしまいます。
今回の場合、
> Set xlSheet = xlBook.Worksheets.Add(after:=Worksheets(xlBook.Worksheets.Count))
がその原因です。

after:=Worksheets(〜) ではなく、
after:=xlBook.Worksheets(〜) とせねばなりません。

親オブジェクトの指定(この場合は xlBook)を忘れていると、今回のように
2回目以降の動作が失敗したり、Excel が終了しなくなるなどの問題を引き起こします。


複数のブックを同時に開いて操作するような場合を想像してみてください。
単に Workbooks と記述した場合、その処理対象となるのが、
xlBook1.Workbooks なのか、xlBook2.Workbooks の事なのか、不明瞭になりますよね。

ですから、外部から Excel を操作するような場合は、親オブジェクトを明示的に
指定する事は必須の作業と言えるでしょう。

>     strToday = Year(Date) & Format(Month(Date), "0#") & Format(Day(Date), "0#")
今回使っている言語は、(VBScript では無く)VB なのですから、
　strToday = Format(Date, "yyyymmdd")
と書いた方がスッキリ書けますよ。

>     Set xlApp = CreateObject("Excel.Application")
参照設定している場合は、
　Set xlApp = New Excel.Application
の方が良いでしょう。

> tmpSheet = ws.Name
> If InStrB(1, tmpSheet, strExcelSheet, -1) <> 0 Then
なぜ、(InStr ではなく)InStrB を使っておられるのでしょうか?

>     With xlSheet
>     End With
これは一体?

>     Do Until objDs.EOF
ちなみに、Recordset オブジェクトの内容をワークシートに転記するために、
CopyFromRecordset というメソッドが用意されていたりもします。

ありがとうございます。

説明、および、ソースのおかしいところの指摘、解説
ありがとうございます。
大変参考になります。

> after:=Worksheets(〜) ではなく、
> after:=xlBook.Worksheets(〜) とせねばなりません。

> 親オブジェクトの指定(この場合は xlBook)を忘れていると、今回のように
> 2回目以降の動作が失敗したり、Excel が終了しなくなるなどの問題を引き起こします。
については、前の書き込みで、魔界の仮面弁士さんからご指摘して貰っているのに
生かされていませんでした。

>>     Set xlApp = CreateObject("Excel.Application")
> 参照設定している場合は、
> 　Set xlApp = New Excel.Application
> の方が良いでしょう。
Excel・Word関係 [ http://hanatyan.sakura.ne.jp/vbhlp/excelframe.htm ]
Office アプリケーションのインスタンスを作成する場合は、New 関数の代わりに
CreateObject 関数を使用してください。
とありましたので、CreateObject 関数を使いました。

>> tmpSheet = ws.Name
>> If InStrB(1, tmpSheet, strExcelSheet, -1) <> 0 Then
>なぜ、(InStr ではなく)InStrB を使っておられるのでしょうか?
バイトとバイナリを勘違いしていました。
If InStr(1, tmpSheet, strExcelSheet, 0) <> 0 Then
で、比較のモードは、”-1”と”0”のどちらがよいのでしょうか。

>>     Do Until objDs.EOF
> ちなみに、Recordset オブジェクトの内容をワークシートに転記するために、
> CopyFromRecordset というメソッドが用意されていたりもします。
知りませんでした。調べてみます。

>>     With xlSheet
>>     End With
>これは一体?
1行目に見出し行を入れています。
データを設定したあと、罫線などをつけています。
その部分の処理を除いていました。

-----
    xlSheet.Cells.NumberFormat = "@"
    ColCnt = 17
    With xlSheet
        .Cells(1, 1) = "項目1"
        .Cells(1, 2) = "項目2"
        .Cells(1, 3) = "項目3"
          :
          :
        .Cells(1, 16) = "項目16"
        .Cells(1, 17) = "項目17"
    End With

    I = 2
    Do Until objDs.EOF
        With xlSheet
            If Not IsNull(objDs(2).Value) Then
                .Cells(I, 1) = objDs(1).Value & " " & objDs(2).Value
            Else
                .Cells(I, 1) = objDs(1).Value
            End If
            .Cells(I, 2) = objDs(3).Value
            .Cells(I, 3) = objDs(4).Value
            If Not IsNull(objDs(5).Value) Then
                .Cells(I, 4) = objDs(5).Value
            End If
            .Cells(I, 5) = objDs(6).Value
              :
              :
            .Cells(I, 16) = objDs(17).Value
            .Cells(I, 17) = objDs(18).Value
        End With

        I = I + 1
        objDs.DbMoveNext
    Loop
    RowCnt = I - 1

    With xlSheet
        .Range(.Cells(1, 1), .Cells(RowCnt, ColCnt)).Borders.LineStyle = xlContinuous '実線
        .Range(.Cells(1, 1), .Cells(RowCnt, ColCnt)).Borders(xlEdgeTop).LineStyle = xlGray75
        .Range(.Cells(1, 1), .Cells(RowCnt, ColCnt)).Borders(xlEdgeLeft).LineStyle = xlGray75
        .Range(.Cells(1, 1), .Cells(RowCnt, ColCnt)).Borders(xlEdgeRight).LineStyle = xlGray75
        .Range(.Cells(RowCnt, 1), .Cells(RowCnt, ColCnt)).Borders(xlEdgeBottom).LineStyle = xlGray75
        .Range(.Cells(1, 1), .Cells(1, ColCnt)).Borders(xlEdgeBottom).LineStyle = xlDouble
        .Range(.Cells(1, 1), .Cells(1, ColCnt)).Interior.Color = RGB(192, 192, 192)

        If RowCnt <> 1 Then
            .Cells.VerticalAlignment = xlVAlignCenter
            .Range("A:A").HorizontalAlignment = xlLeft
            .Range("B:B", "Q:Q").HorizontalAlignment = xlVAlignCenter
        End If
    End With
-----

ありがとうございます。
一応、エラーなどが発生せず、動きました。

> 参照設定している場合は、
> 　Set xlApp = New Excel.Application
> の方が良いでしょう。
参照設定している場合は、New をつけるとありますが、
[プロジェクト]→[参照設定]で、Excelを指定している
ということでよろしいでしょうか。

また、変数の宣言で、オブジェクト生成を 宣言と同時にした場合、
つまり、

　Dim xlApp as New Excel.Application

とした場合、

　Set xlApp = Excel.Application
　Set xlApp = New Excel.Application

の指定は、不要でよいのでしょうか。

有っても、無くても、一応は、エラーなど発生せず動きうごきましたが、
書いたとしても２重生成（同じことを繰り返す）となるだけですよね。

　Dim xlApp as Excel.Application
　Set xlApp = New Excel.Application

とした場合は、必要となる。

> 参照設定している場合は、New をつけるとありますが、
> [プロジェクト]→[参照設定]で、Excelを指定している
> ということでよろしいでしょうか。
はい、そういう意味で書きました。
ただし、参照設定している場合は、Excel のバージョンは固定的となります。
(例えば、Excel 2003 環境で開発したexeを、Excel 97 環境で動かす事は難しいという事)

異なるバージョンにも対応させたいのであれば、参照設定は行わないようにし、
生成処理も、CreateObject で行うようにしてください。


> 　Dim xlApp as New Excel.Application
宣言時に New を付ける書き方は推奨できません。使えない事も無いのですが、
オブジェクトの作成と解放のタイミングを制御するのが困難になります。

> 　Set xlApp = Excel.Application
その書き方は、絶対に行ってはいけません。
これは、(グローバル オブジェクトとしての)Application プロパティの参照を意味します。


開発環境で、[F2]キーを押し、オブジェクトブラウザを表示してください。

ライブラリとして[Excel]を選択し、クラスから[<グローバル>]を選択したときに、
メンバとして表示される物は、VB6 からは利用しないようにしてください。
それらは Excel VBA からの利用を前提としたものであり、外部から利用した場合には、
オブジェクトの解放漏れや、2 回目の処理に失敗するなどの弊害を引き起こします。


> 　Set xlApp = New Excel.Application
この書き方であれば問題ありません。

ありがとうございます。

ご説明、ご解説ありがとうございます。
大変、勉強になります。