AccessVBAでExcelを開いて色々処理したいが、タスクが消えずに残る

Question

連日質問続きで申し訳ありません。
VBAを初めて20日ちょっとで詰まりに詰まっています。

Accessのフォームのテキストボックスに、触りたいエクセルファイルのパスが入っています。
Accessの同じフォームのボタンを押すと、エクセルファイルが弄られて保存される、というシステムを作ろうとしています。

ザっと見て、これでなぜタスクが残るかわかる方はおられませんか…？
昨日今日と丸一日以上調べて弄っていました。
Excelファイルを外部から触るときはオブジェクトに格納してSet, Close, Quit, Nothing等を使って、解放してあげるとタスクが残らない、と知りやってみましたがタスクが残ります。

また、Selection.ShapeRange.ShapeStyleがあやしいと思ってコメント化してもタスクは残りました。

欲しい結果は出ますが、タスクが残るせいで連続してフォームのボタンを押すとエラーが出るのをなくしたいのです。

どうか知恵をお貸しいただけたらと思います。（だいぶ長くなるので短くしています、見辛い部分もあると思いますがご了承ください）

Set mdb = mdbDB.OpenRecordset(strSQL)

'Excelオブジェクトを生成
Set xls = CreateObject("Excel.Application")
Set wb = xls.Workbooks.Open(Me.txtPath.Value)


With xls
  '画面の再描画を抑止
  .ScreenUpdating = False
  
Do Until mdb.EOF

  '新しい社名が入ったとき
  If mdb(0) <> "" And cname <> mdb(0) Then
    wb.Worksheets("依頼書").Copy After:=wb.Worksheets(wb.Worksheets.count)   ' 末尾に追加
    
    shina = False

    wb.ActiveSheet.Name = mdbRST1(0)
    wb.ActiveSheet.Cells(10, 2).Value = mdb(0)
    wb.ActiveSheet.Cells(11, 2).Value = mdb(1)
    wb.ActiveSheet.Cells(16, 6).Value = mdb(2)
    
    i = 1
    
    wb.ActiveSheet.Cells(12, 2).Value = total
    cname = mdb(0)
    
        If mdb(4) = "品" Then
            '品に〇をつける
            wb.ActiveSheet.Shapes.AddShape(msoShapeOval, 6.75, 102, 27, 15).Select
            Selection.ShapeRange.ShapeStyle = msoShapeStylePreset50
            wb.ActiveSheet.Cells(16, 8).Value = "品"
            shina = True
            
        Else
                MsgBox "種別が正しくない項目があります。 発注先 = " & mdb(0)

        End If
        
    mdbRST1.MoveNext
  
  '既存の社名が入ったとき
  Else
    wb.ActiveSheet.Cells(16 + i, 6).Value = mdb(2)
    wb.ActiveSheet.Cells(16 + i, 9).Value = mdb(3) * taxmath
    total = total + mdb(3) * taxmath
    wb.ActiveSheet.Cells(12, 2).Value = total
    
        If mdb(4) = "品" Then
        '品に〇をつける
            wb.ActiveSheet.Cells(16 + i, 8).Value = "品"
                        
                If shina <> True Then
                    wb.ActiveSheet.Shapes.AddShape(msoShapeOval, 6.75, 102, 27, 15).Select
                    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset50
                    shina = True
                End If
                
   
        '項目が6行を超えるときに罫線を描く
        If i > 6 Then
            wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeTop).LineStyle = xlDash
            wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeRight).LineStyle = xlContinuous
            wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeBottom).LineStyle = xlContinuous
            wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 7)).Borders(xlEdgeRight).LineStyle = xlDash
            
            wb.ActiveSheet.Range("A1").Select

                    
        End If
        
    i = i + 1
    mdb.MoveNext
  
  End If

Loop


  mdb.Close

  'A1セルだけを選択状態にする
   wb.ActiveSheet.Range("A1").Select
  '画面の再描画を元に戻す
  .ScreenUpdating = True
  'Excelを可視状態にする
  '.Visible = True
  
  Dim strFilePath As String
  Dim strFilename As String
  Dim PathName As String
  Dim Filename As String
  
  'txtBoxからパスだけ取ってくる
  Filename = Dir(Me.txtPath.Value)
  PathName = Replace(Me.txtPath.Value, Filename, "")

  strFilename = Format(Now(), "yyyy-mm-dd-hh-mm-ss") & ".xlsx"
  strFilePath = PathName & strFilename

  wb.SaveAs Filename:=strFilePath
  
  MsgBox "ファイルの保存が完了しました" & vbCrLf & _
         "保存先は" & strFilePath & "です。"

End With

wb.Close
xls.Quit
Set xls = Nothing

Comments

[hatena19]

残るタスクはなんのタスクですか。Excelですか。
また、それをどのように確認しましたか。

[koH_dr7]

コメントありがとうございます！
Excelのタスクです。
タスクマネージャーで確認しました。
裏で開いたままになっているようです。

Answer 1

気になったところは以下です。
SelectionとかCellsとかxlDashとかxlContinuousとかxlEdgeTopとかxlEdgeLeftとかxlEdgeRightとかxlEdgeBottomとか親オブジェクトを指定していないですが、全てExcelのオブジェクトなんでエラー出てませんか？
あと念のためwbもNothing入れておいてください。

' ・・・略・・・
            'Selection.ShapeRange.ShapeStyle = msoShapeStylePreset50
            ' ↓
            xls.Selection.ShapeRange.ShapeStyle = msoShapeStylePreset50 
' ・・・略・・・
                    'Selection.ShapeRange.ShapeStyle = msoShapeStylePreset50
                    ' ↓
                    xls.Selection.ShapeRange.ShapeStyle = msoShapeStylePreset50
' ・・・略・・・
            'wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeTop).LineStyle = xlDash
            ' ↓
            wb.ActiveSheet.Range(wb.ActiveSheet.Cells(16 + i, 6), wb.ActiveSheet.Cells(16 + i, 11)).Borders(xls.XlBordersIndex.xlEdgeTop).LineStyle = xls.XlLineStyle.xlDash

            'wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeLeft).LineStyle = xlContinuous
            ' ↓
            wb.ActiveSheet.Range(wb.ActiveSheet.Cells(16 + i, 6), wb.ActiveSheet.Cells(16 + i, 11)).Borders(xls.XlBordersIndex.xlEdgeLeft).LineStyle = xls.XlLineStyle.xlContinuous

            'wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeRight).LineStyle = xlContinuous
            ' ↓
            wb.ActiveSheet.Range(wb.ActiveSheet.Cells(16 + i, 6), wb.ActiveSheet.Cells(16 + i, 11)).Borders(xls.XlBordersIndex.xlEdgeRight).LineStyle = xls.XlLineStyle.xlContinuous

            'wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 11)).Borders(xlEdgeBottom).LineStyle = xlContinuous
            ' ↓
            wb.ActiveSheet.Range(wb.ActiveSheet.Cells(16 + i, 6), wb.ActiveSheet.Cells(16 + i, 11)).Borders(xls.XlBordersIndex.xlEdgeBottom).LineStyle = xls.XlLineStyle.xlContinuous

            'wb.ActiveSheet.Range(Cells(16 + i, 6), Cells(16 + i, 7)).Borders(xlEdgeRight).LineStyle = xlDash
            ' ↓
            wb.ActiveSheet.Range(wb.ActiveSheet.Cells(16 + i, 6), wb.ActiveSheet.Cells(16 + i, 7)).Borders(xls.XlBordersIndex.xlEdgeRight).LineStyle = xls.XlLineStyle.xlDash
' ・・・略・・・
wb.Close
Set wb = Nothing
xls.Quit
Set xls = Nothing

Comments

[hatena19]

確かにSelectionでエラーが出るはずですよね。見落としてました。
質問のコードにはエラー処理がないのでエラーが出るはずですが、その点については質問で言及がないのはなぜなのか？

[Y.H.]

どこかこの処理の前でOn Error Resume Nextされてるのかなぁとエスパーしたうえで
「全てExcelのオブジェクトなんでエラー出てませんか？」との記載にとどめました。

[hatena19]

たぶんそうですね。
On Error Resume Next の意味を理解していない。

[koH_dr7]

On Error Resume Nextの意味、知りませんでした、勉強になります。
エラー処理をしていないのですが、エラーが出ません…。
Selectionの命令も通り、引きたい罫線も引ける状態です。
ツール→参照設定→Excel Object Libraryでチェックは入っています、これで通っているのでしょうか？

[hatena19]

On Error Resume Next 以外に、On Error で始まる行はないですか。
あればコメントアウトしてください。
Selection は、xls.Selection に修正してください。

[Y.H.]

> ツール→参照設定→Excel Object Libraryでチェックは入っています
であれば、「xlDashとかxlContinuousとかxlEdgeTopとかxlEdgeLeftとかxlEdgeRightとかxlEdgeBottom」はエラーになりません。
SelectionとかCellsとかは何を参照するんだろう？？？
CreateObjectしたExcel.Applicationと、Excel Object Libraryで参照したExcel.Applicationの二つのインスタンスが起動してたりするんだろうか・・・

[hatena19]

Access.Application には Selection はないので、xls.Selection としないとエラーが出るはずなんですが、質問者さんはエラー処理はしてないといってますし、謎です。

参照設定しただけでは、Excel.Application は生成されないです。
Dim xl As Excel.Application
Set xl = New Excel.Application
とNewしたときに生成されるはずです。
参照設定した場合は、 CreateObject ではなく、Newで生成したほうがいいと思います。

[koH_dr7]

ありがとうございます！！
xls.SelectionとCellsの書き方で見事にタスクが消えました。連続で使うこともできました！
タスクマネージャーから緑のアイコンが消えた瞬間声が出ました…。
助かりました、本当にありがとうございました！

Answer 2

呈示されているコードを見る限りは、原因となるようなものは見つけることはできません。
他の部分に問題がある可能性も検討ください。
それと、コード実行中にエラーが出るということはないですよね。

どうしても分からない場合は、まずはなるべくシンプルなコードを書いて実行してみて、タスクが残るか確認する。
少しずつ必要な処理を追加していって、その都度タスクが残るか確認する。
タスクが残った時に、その直前で追加した処理に問題がある。

というようなデバッグ作業で原因を特定するということになると思います。

とりあえず下記のようなコードでタスクが残らないことを確認してから、コードを少しずつ追加していってみてください。

'Excelオブジェクトを生成
Dim xls As Object
Set xls = CreateObject("Excel.Application")
Dim wb As Object
Set wb = xls.Workbooks.Open(Me.txtPath.Value)

xls.Visible = True 'デバッグ作業中は表示させておいた方がよい
'エラー処理があるならコメントアウトしておく


wb.Close
xls.Quit
Set xls = Nothing

追記

あと、デバッグ(想定通りに動作しない場合に原因を特定する作業)するときは、
エラー処理は無効にしておく必要があります。
具体的には、

On Error ・・・・

の行は、先頭に ' を挿入してコメントアウト（無効）にしておく。

'On Error ・・・・

Comments

[koH_dr7]

デバッグのやり方等をしらないまま、VBAに取り組んできましたが、少しずつ探るのですね。
どこが原因か今から探してみます、ありがとうございました！