自作ソフト[Excel Com オブジェクトの解放漏れチェックツール]の紹介(VB2005～)

　下記プログラムコードに関する補足・注意事項　
動作確認：Windows 8.1 (Windows 7) / VB2013 (VB2010) / Framework 4.5.1 / 対象の CPU：x86
Option　：[Compare Text] [Explicit On] [Infer On] [Strict On]
Imports ：追加なし
参照設定：追加なし
その他　：
　　　　：
このサンプル等の内容を無断で転載、掲載、配布する事はお断りします。(私の修正・改訂・削除等が及ばなくなるので)
必要ならリンクをはるようにして下さい。(引用の場合は引用元のリンクを明記して下さい)

１．Excel Com オブジェクトの解放漏れチェックツール

Excel の Com オブジェクト及びCom オブジェクトを返すプロパティ等をカラー化
Excel の Com オブジェクト等を変数に受けていない場合、太字に設定
Excel の Com オブジェクト等の変数を使用後、直ちにデクリメントしているかを調査
上記のような、Excel のプロセスが解放されない原因を調査するツールです。
詳しくは、開発当初のExcel Com オブジェクトの解放漏れチェックツールを紹介しているので参考にして下さい。
又、添付の HelpFile.rtf に簡単な使用方法や説明を記載しているのでそちらも参考にして下さい。

図１．テスト用ファイル[VB2013\09_Xls_10\Form2.vb]を読み込みテストした図
vb2013software11-01

２．検出テスト用のコードを検出テストした結果

以下のコードは、検出テスト用のコードなので、実際に使用したり実行しないで下さい。

Private xlApp As Excel.Application
Private xlBooks As Excel.Workbooks
Private xlBook As Excel.Workbook
Private xlSheets As Excel.Sheets
Private xlSheet As Excel.Worksheet

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    '------　間違った Font オブジェクトの使い方　---------------------------------
    Dim xlRange As Excel.Range
    xlRange = xlSheet.Range("B2")
    xlRange.Value = "あいうえお"

    '★★ Font オブジェクトを変数に受けてデクリメントしないと解放できない。
    With xlRange.Font
        .Color = Color.Red
    End With

    '------　正しい Font オブジェクトの使い方　---------------------------------
    Dim xlRange1 As Excel.Range
    Dim xlFont As Excel.Font
    xlRange1 = xlSheet.Range("B2")
    xlRange1.Value = "あいうえお"
    xlFont = xlRange1.Font
    '◎ xlFont が太字になっているが、続く語句に赤色や太字がないので問題がない。
    With xlFont
        .Color = Color.Red
    End With

    MRComObject(xlFont)
    MRComObject(xlRange1)
End Sub

'但し、上記のコードでは、デクリメント調査すると xlRange が検出されません。
'xlRange1 が xlRange と見なされて検索されるので、似たような変数名を使用する場合は
'下記のように設定して下さい。

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
    '------　間違った Font オブジェクトの使い方　---------------------------------
    Dim xlRange1 As Excel.Range
    xlRange1 = xlSheet.Range("B2")
    xlRange1.Value = "あいうえお"

    '★★ Font オブジェクトを変数に受けてデクリメントしないと解放できない。
    With xlRange1.Font
        .Color = Color.Red
    End With

    '------　正しい Font オブジェクトの使い方　---------------------------------
    Dim xlRange2 As Excel.Range
    Dim xlFont As Excel.Font
    xlRange2 = xlSheet.Range("B2")
    xlRange2.Value = "あいうえお"
    xlFont = xlRange1.Font
    With xlFont
        .Color = Color.Red
    End With

    MRComObject(xlFont)
    MRComObject(xlRange2)
'これなら xlRange1 と xlRange2 は、前方一致検索でも違うと判断されるので
'デクリメント調査で、xlRange1 の解放処理が忘れられているのが見つかる。
End Sub

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
    '-------------------- マクロの記録を取った場合 ----------------------------
    'ActiveCell.FormulaR1C1 = "あいうえお"
    'Range("A1").Select
    'Selection.Copy
    'Range("D1").Select
    'ActiveSheet.Paste
    '--------------------------------------------------------------------------

    '上記マクロは、VB2005 ～では通常下記のように書き換えます。
    'ActiveCell とか Selection とか ActiveSheet のような不特定のものは、VB からは使用しない。
    Dim xlRange1 As Excel.Range
    xlRange1 = xlSheet.Range("A1")
    xlRange1.Value = "あいうえお"
    xlRange1.Copy()
    '★★ Range("D1") を変数に受けてデクリメントしないと解放されない。
    xlSheet.Paste(xlSheet.Range("D1"))
    MRComObject(xlRange1)  'Range オブジェクトの解放処理へ

    '------　正しい Range オブジェクトの使い方　---------------------------------
    Dim xlRange2 As Excel.Range
    xlRange2 = xlSheet.Range("A1")
    xlRange2.Value = "あいうえお"
    xlRange2.Copy()
    Dim xlRange3 As Excel.Range
    xlRange3 = xlSheet.Range("D1")
    xlSheet.Paste(xlRange3)

    MRComObject(xlRange2)  'Range オブジェクトの解放処理へ
    MRComObject(xlRange3)  'Range オブジェクトの解放処理へ
End Sub

Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
    Dim xlRange As Excel.Range
    xlRange = xlSheet.Range("C2")
    xlRange.Value = "あいうえお"
    Dim xlCharacters As Excel.Characters
    xlCharacters = xlRange.Characters(Start:=2, Length:=3)

    '★★ Font オブジェクトを変数に受けてデクリメントしないと解放できない。
    With xlCharacters.Font
        .Name = "ＭＳ明朝"
        'フォントスタイルを設定(文字列型 (String) の値を使用)
        .FontStyle = "太字斜体"
        .Size = 15
        .Strikethrough = True      '取り消し線
        .Superscript = False       'True の場合、対象となるフォントが上付き文字になります
        .Subscript = False         'True の場合、対象となるフォントは下付き文字になります
        .OutlineFont = False       'True の場合、フォントをアウトラインフォントにします
        .Shadow = True             'True の場合、フォントを影付きフォントに、
        .ThemeFont = Excel.XlThemeFont.xlThemeFontNone
    End With

    MRComObject(xlCharacters)
    MRComObject(xlRange)
End Sub

Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
    Dim xlShapes1 As Excel.Shapes
    xlShapes1 = xlSheet.Shapes
    Dim xlShape1 As Excel.Shape
    xlShape1 = xlShapes1.Item(0)
    '◎ この場合は、続くプロパティ等を確認すればいいだけです。
    With xlShape1
        .ScaleHeight(1.0!, MsoTriState.msoTrue)
        .ScaleWidth(1.0!, MsoTriState.msoTrue)
    End With
    MRComObject(xlShape1, True)
    MRComObject(xlShapes1)
End Sub

Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
    Dim xlShapes As Excel.Shapes
    xlShapes = xlSheet.Shapes
    '★★ AddShape を変数に受けてデクリメントする必要がある。
    xlShapes.AddShape(MsoAutoShapeType.msoShapeCloudCallout, 100, 30, 100, 40)
    '★★ AddShape を変数に受けてデクリメントする必要がある。
    xlShapes.AddShape(MsoAutoShapeType.msoShapeRightArrow, 100, 100, 50, 50)
    '★★ AddLine 及び Line を変数に受けてデクリメントする必要がある。
    With xlShapes.AddLine(100, 200, 250, 200).Line
        .EndArrowheadLength = MsoArrowheadLength.msoArrowheadLong
        .EndArrowheadStyle = MsoArrowheadStyle.msoArrowheadTriangle
        .EndArrowheadWidth = MsoArrowheadWidth.msoArrowheadWide
        .Weight = 5.0#
    End With

    '★★ Item を変数に受けてデクリメントする必要がある。
    xlShapes.Item(1).Delete()
    System.Threading.Thread.Sleep(1000)

    '◎ 下記のように個別に受けて処理しないとデクリメントができない。
    xlShapes = xlSheet.Shapes
    Dim xlShape As Excel.Shape = xlShapes.Item(1)
    xlShape.Delete()
    MRComObject(xlShape)
    MRComObject(xlShapes)

    '◎ 全てを削除する場合(Selection.Delete が使用できないので)
    Dim shp As Excel.Shape = Nothing
    For Each shp In xlShapes
        shp.Delete()
    Next
    MRComObject(shp, True)     '◎ 複数使用しているので、 True で解放
    MRComObject(xlShapes)      '◎ このような使い方でも解放されます。
End Sub

Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
    Dim xlRange As Excel.Range
    xlRange = xlSheet.Range("A:X")
    MessageBox.Show(Me, xlRange.ColumnWidth.ToString())    '8.38(72ピクセル）
    MessageBox.Show(Me, xlRange.Width.ToString())          '1296
    xlRange.ColumnWidth = 5

    'MRComObject(xlRange)    '◎ 場合 xlRange の参照先が変わるので、一旦解放する必要がある
    '★★ 以下同様の解放漏れが多く発生します。

    xlRange = xlSheet.Range("B1:D1")
    xlRange.Value = "あいうえおかきくけこ"

    '★★ Columns を変数に受けてデクリメントする必要がある。
    xlRange.Columns.AutoFit()
    MRComObject(xlRange)

    '◎ この場合下記のようにすれば解放されます。
    'Dim xlColumns As Excel.Range
    'xlColumns = xlSheet.Columns
    'xlColumns.AutoFit()
    'MRComObject(xlColumns)
End Sub

Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click
    Dim xlRange As Excel.Range
    xlRange = xlSheet.Range("3:10")
    xlRange.RowHeight = 25
    '★★ Rows を変数に受けてデクリメントする必要がある。
    xlRange.Rows.AutoFit()
    MRComObject(xlRange)
End Sub

Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click
    Dim xlRange As Excel.Range
    Dim Dat(2, 5) As Object
    Dat(0, 0) = 4 : Dat(0, 1) = 4 : Dat(0, 2) = 5 : Dat(0, 3) = 8 : Dat(0, 4) = 9 : Dat(0, 5) = ""
    Dat(1, 0) = 3 : Dat(1, 1) = 3 : Dat(1, 2) = 5 : Dat(1, 3) = 9 : Dat(1, 4) = "" : Dat(1, 5) = ""
    Dat(2, 0) = 1 : Dat(2, 1) = 7 : Dat(2, 2) = 1 : Dat(2, 3) = 6 : Dat(2, 4) = 4 : Dat(2, 5) = 3
    xlRange = xlSheet.Range("A1:F3")    'データの入力セル範囲
    xlRange.Value = Dat                                   'セルへデータの入力
    xlRange = xlSheet.Range("A1")
    xlRange.Activate()

    '★★ CurrentRegion を変数に受けてデクリメントする必要がある。
    xlRange.CurrentRegion.Select()
    Dim xlCells As Excel.Range

    '★★ Cells の使い方が間違っているのでデクリメントができない。
    xlCells = CType(xlSheet.Cells(5, 1), Excel.Range)
    xlCells.Value = "セル A1 があるActivateセル領域は " & _
            xlRange.CurrentRegion.Address(False, False, Excel.XlReferenceStyle.xlA1) & " の範囲です。"  'A1:F3

    '★★ Cells の使い方が間違っているのでデクリメントができない。
    xlCells = CType(xlSheet.Cells(6, 1), Excel.Range)

    '★★ UsedRange を変数に受けてデクリメントする必要がある。
    xlCells.Value = "使用済みセル領域は " & _
            xlSheet.UsedRange.Address(False, False, Excel.XlReferenceStyle.xlA1) & " です。"   'A1:F5
    MRComObject(xlCells)
    MRComObject(xlRange)
End Sub

Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click
    Dim xlRange As Excel.Range = Nothing
    For c As Integer = 1 To 10
        For r As Integer = 1 To 20
            xlRange = xlSheet.Range("A1")
            xlRange.Value = r + c
            ' MRComObject(xlRange)
        Next r
    Next c
    '★★ この場合、問題だがうまく検出できない。
    MRComObject(xlRange, True)
    Dim xlRow As Excel.Range

    '★★ Rows.Item を変数に受けてデクリメントする必要がある。
    xlRow = CType(xlSheet.Rows.Item(5), Excel.Range)

    xlRow.Insert()
    xlRow.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftDown)  '上記と同じ
    MRComObject(xlRow)
    xlRange = xlSheet.Range("5:5")
    xlRange.Insert()
    xlRange = xlSheet.Range("B5")

    '★★ EntireRow を変数に受けてデクリメントする必要がある。
    xlRange.EntireRow.Insert()

    MRComObject(xlRange, True)
    Dim xlColumn As Excel.Range

    '★★ Columns.Item を変数に受けてデクリメントする必要がある。
    xlColumn = CType(xlSheet.Columns.Item(5), Excel.Range)
    xlColumn.Insert()
    xlRange = xlSheet.Range("E:E")
    xlRange.Insert()

    '★★ EntireColumn を変数に受けてデクリメントする必要がある。
    xlRange.EntireColumn.Insert()
    MRComObject(xlColumn, True)
    MRComObject(xlRange, True)
    xlRange = xlSheet.Range("C5")
    xlRange.Insert()
    xlRange = xlSheet.Range("C3")
    xlRange.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftToRight)
    MRComObject(xlRange, True)

    '★★ Rows.Item を変数に受けてデクリメントする必要がある。
    xlRow = CType(xlSheet.Rows.Item(5), Excel.Range)
    xlRow.Delete()
    xlRange = xlSheet.Range("5:5")
    xlRange.Delete()
    xlRange = xlSheet.Range("A5")

    '★★ EntireRow を変数に受けてデクリメントする必要がある。
    xlRange.EntireRow.Delete()
    MRComObject(xlRow)
    MRComObject(xlRange, True)
    xlRange = xlSheet.Range("C3")
    xlRange.Delete(Shift:=Excel.XlDeleteShiftDirection.xlShiftToLeft)

    '★★ Columns.Item を変数に受けてデクリメントする必要がある。
    xlColumn = CType(xlSheet.Columns.Item(5), Excel.Range)
    xlColumn.Delete()
    xlRange = xlSheet.Range("A5")

    '★★ EntireRow を変数に受けてデクリメントする必要がある。
    xlRange.EntireRow.Delete()
    xlRange = xlSheet.Range("E:E")
    xlRange.Delete()
    xlRange = xlSheet.Range("E:E")   '再度指定しないと削除済みなのでエラーとなります。

    '★★ EntireColumn を変数に受けてデクリメントする必要がある。
    xlRange.EntireColumn.Delete()
    xlRange = xlSheet.Range("C5")
    xlRange.Delete()
    MRComObject(xlColumn, True)
    MRComObject(xlRange, True)
End Sub

Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click
    Dim xlRange As Excel.Range
    Dim xlTRange As Excel.Range
    xlRange = xlSheet.Range("A1:H20")   '指定のセル範囲内
    xlTRange = xlSheet.Range("G15")     '指定のセル位置

    '★★ Intersect を変数に受けてデクリメントする必要がある。
    If Not xlApp.Intersect(xlTRange, xlRange) Is Nothing Then
        MessageBox.Show(Me, " セル[" & xlTRange.Address(False, False) & "]は、セル[" & _
                                        xlRange.Address(False, False) & "]の範囲内にあります。")
    Else
        MessageBox.Show(Me, " セル[" & xlTRange.Address(False, False) & "]は、セル[" & _
                                        xlRange.Address(False, False) & "]の範囲内には、ありません。")
    End If
    xlTRange = xlSheet.Range("A1:G21")

    '★★ Intersect を変数に受けてデクリメントする必要がある。
    If Not xlApp.Intersect(xlTRange, xlRange) Is Nothing Then
        'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。
        MessageBox.Show(Me, " セル[" & xlTRange.Address(False, False) & "]は、セル[" & _
                                        xlRange.Address(False, False) & "]の範囲内にあります。")
    Else
        MessageBox.Show(Me, " セル[" & xlTRange.Address(False, False) & "]は、セル[" & _
                                        xlRange.Address(False, False) & "]の範囲内には、ありません。")
    End If
    MRComObject(xlTRange)
    MRComObject(xlRange)
End Sub

Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click
    Dim sheetCount As Integer

    '★★ Worksheets を変数に受けてデクリメントする必要がある。
    sheetCount = xlBook.Worksheets.Count
    MessageBox.Show(Me, "現在のシート(Worksheet)数 = " & sheetCount & " です。")

    '★★ Worksheets を変数に受けてデクリメントする必要がある。
    xlBook.Worksheets.Add()
    sheetCount = xlBook.Worksheets.Count
    MessageBox.Show(Me, "シートを１個追加したので、Worksheet 数 = " & sheetCount & " です。")
    Dim xlSheet1 As Excel.Worksheet

    '★★ Worksheets を変数に受けてデクリメントする必要がある。
    xlSheet1 = CType(xlBook.Worksheets.Item(sheetCount), Excel.Worksheet)
    MessageBox.Show(Me, "追加したシート名 = " & xlSheet1.Name & " です。")
    xlSheet1.Name = "Test1"
    MessageBox.Show(Me, "シート名を " & xlSheet1.Name & " に変更しました。")
    xlSheet1.Delete()

    '★★ Worksheets を変数に受けてデクリメントする必要がある。
    sheetCount = xlBook.Worksheets.Count
    MessageBox.Show(Me, "追加したシートを削除したので、Worksheet 数 = " & sheetCount & " です。")
    Dim Sheet As Excel.Worksheet = Nothing

    '★★ Worksheets を変数に受けてデクリメントする必要がある。
    For Each Sheet In xlBook.Worksheets
        Debug.Print(Sheet.Name)
    Next

    '◎ まだ、同じComObject の xlSheet , xlSheet1 を解放(デクリメント)していないので、
    ' ”要調査！デクリメントされていません。”のメッセージがでますが無視して下さい。
    MRComObject(Sheet)
    '最後に解放されましたのメッセージがでれば、OK です。
    MRComObject(xlSheet1)
End Sub

Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click
    Dim xlRange As Excel.Range = Nothing
    Dim retValue As Double = 0
    For c As Integer = 1 To 5
        For r As Integer = 1 To 6
            xlRange = xlSheet.Range("A1")
            retValue += 1
            xlRange.Value = retValue
            'MRComObject(xlRange)
        Next r
    Next c
    xlRange = xlSheet.Range("C3")
    xlRange.Activate()

    '★★ CurrentRegion を変数に受けてデクリメントする必要がある。
    xlRange.CurrentRegion.Select()

    '★★ CurrentRegion を変数に受けてデクリメントする必要がある。
    Dim r1c1() As Integer = A1ToR1C1(xlRange.CurrentRegion.Address(False, False, Excel.XlReferenceStyle.xlA1))
    Dim r1 As Integer = r1c1(0)    '1　行
    Dim C1 As Integer = r1c1(1)    '1　列
    Dim r2 As Integer = r1c1(2)    '6 行
    Dim C2 As Integer = r1c1(3)    '5 列
    xlRange = xlSheet.Range("A1")
    xlRange.FormulaR1C1 = "=SUM(RC[-" & CInt(C2 - C1 + 1) & "]:RC[-1])"
    Dim xlRange1 As Excel.Range
    xlRange1 = xlSheet.Range("A1")
    xlRange.AutoFill(Destination:=xlRange1, Type:=Excel.XlAutoFillType.xlFillDefault)
    xlRange = xlSheet.Range("A1")
    '列の合計を求める
    xlRange.Formula = "=SUM(R[-" & CInt(r2 - r1 + 1) & "]C:R[-1]C)"
    xlRange1 = xlSheet.Range("A1")
    xlRange.AutoFill(Destination:=xlRange1, Type:=Excel.XlAutoFillType.xlFillDefault)
    MRComObject(xlRange)
    MRComObject(xlRange1)
End Sub

Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click
    Dim Dat(9, 0) As Object
    Dat(0, 0) = "品　名" : Dat(1, 0) = "みかん" : Dat(2, 0) = "トマト"
    Dat(3, 0) = "いちご" : Dat(4, 0) = "みかん" : Dat(5, 0) = "トマト"
    Dat(6, 0) = "いちご" : Dat(7, 0) = "みかん" : Dat(8, 0) = "トマト"
    Dat(9, 0) = "いちご"
    Dim xlRange As Excel.Range
    xlRange = xlSheet.Range("B2:B11")
    xlRange.Value = Dat

    '★★ Range を変数に受けてデクリメントする必要がある。
    xlSheet.Range("B2:B11").AdvancedFilter(Excel.XlFilterAction.xlFilterInPlace, xlSheet.Range("B2"), , True)
    Dim Count, i As Integer

    '★★ Range 及び End を変数に受けてデクリメントする必要がある。
    Count = xlSheet.Range("B2").End(Excel.XlDirection.xlDown).Row
    For i = 3 To Count
        xlRange = xlSheet.Range("A1")
        If CInt(xlRange.RowHeight) > 0 Then
            '抽出したデータを取得
            Debug.Print(xlRange.Value.ToString)
        End If
    Next i
    MRComObject(xlRange)
End Sub

Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
    Dim xlRange As Excel.Range = Nothing
    Dim retValue As Double = 0
    For c As Integer = 1 To 5
        For r As Integer = 1 To 6
            xlRange = xlSheet.Range("A1")
            retValue += 1
            Dim s1 As String = CStr(ChrW(65 + r + c)) & CStr(ChrW(70 + r + c))
            xlRange.Value = s1 & " " & Str(retValue) & " " & s1
            'MRComObject(xlRange)
        Next r
    Next c
    xlRange = xlSheet.Range("C3")
    xlRange.Activate()

    '★★ CurrentRegion を変数に受けてデクリメントする必要がある。
    xlRange.CurrentRegion.Select()

    '★★ CurrentRegion を変数に受けてデクリメントする必要がある。
    Dim r1c1() As Integer = A1ToR1C1(xlRange.CurrentRegion.Address(False, False, Excel.XlReferenceStyle.xlA1))
    MRComObject(xlRange)
End Sub

Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click
    Dim xlRange As Excel.Range = Nothing
    Dim nRnd As New System.Random()
    For c As Integer = 1 To 10
        For r As Integer = 1 To 20
            xlRange = xlSheet.Range("A1")
            xlRange.Value = nRnd.Next(1, 100)  ' CInt(100 * Rnd())
        Next r
    Next c
    MRComObject(xlRange, True)    'True でなくても解放はされます。
    Dim xlRange1 As Excel.Range
    xlRange1 = xlSheet.Range("B1")
    xlRange = xlSheet.Range("A1:J20")
    '◎ この場合、Sort メソッドなので問題ありません。
    xlRange.Sort(Key1:=xlRange1, Order1:=Excel.XlSortOrder.xlDescending, _
                                Orientation:=Excel.XlSortOrientation.xlSortColumns)
    MRComObject(xlRange1)
    MRComObject(xlRange)
    xlRange1 = xlSheet.Range("B1")
    xlRange = xlSheet.Range("A1:J20")

    '★★ この場合、Sort オブジェクトなので、変数に受けてデクリメントする必要があります。
    With xlSheet.Sort
        '★★ このような場合、.SortFields に続くので変数にうける必要があります。
        .SortFields.Clear()  'SortFields オブジェクトをすべてクリアします
        '★★ このような場合、.SortFields に続くので変数にうける必要があります。
        .SortFields.Add(Key:=xlRange1, _
                    SortOn:=Excel.XlSortOn.xlSortOnValues, _
                    Order:=Excel.XlSortOrder.xlAscending, _
                DataOption:=Excel.XlSortDataOption.xlSortTextAsNumbers)
        .SetRange(xlRange)
        .Header = Excel.XlYesNoGuess.xlNo    'xlNo 既定値。範囲全体が並べ替えの対象になります。
        .MatchCase = False
        .Orientation = Excel.XlSortOrientation.xlSortColumns  '列単位で並べ替えます。(xlTopToBottom と同じ)
        .SortMethod = Excel.XlSortMethod.xlPinYin    '中国語の発音表記の順で並べ替えます。これは既定値です
        .Apply()
    End With
    MRComObject(xlRange1, True)
    MRComObject(xlRange, True)
End Sub

Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click
    Dim xlRange As Excel.Range = Nothing
    For r As Integer = 1 To 20
        For c As Integer = 1 To 10
            xlRange = xlSheet.Range("A1")
            xlRange.Value = Str(r) & "," & Str(c)
        Next
    Next
    MRComObject(xlRange)    '◎ True でなくても解放はされます。
    xlRange = xlSheet.Range("B3:D10")
    xlRange.Copy()
    Dim xlRng As Excel.Range = Nothing

    '★★ Cells を変数に受けてデクリメントする必要がある。
    Dim n As Integer = xlRange.Cells.Count
    Dim dat(n - 1) As String
    Dim no As Integer = -1
    For Each xlRng In xlRange
        no += 1
        dat(no) = xlRng.Value.ToString()
    Next
    MRComObject(xlRng)
    MRComObject(xlRange)
End Sub

Private Sub Button18_Click(sender As Object, e As EventArgs) Handles Button18.Click
    '★★ PageSetup を変数に受けてデクリメントする必要がある。
    With xlSheet.PageSetup
        .PaperSize = Excel.XlPaperSize.xlPaperA4    '用紙サイズをＡ４
        .Orientation = Excel.XlPageOrientation.xlPortrait
        '各余白をセンチ(Cm)単位で設定
        '　　　　　　　 ↓Application でも参照できるが解放されない
        .LeftMargin = xlApp.CentimetersToPoints(2)      '左余白を 20 mm に設定
        .RightMargin = xlApp.CentimetersToPoints(2)     '右余白を 20 mm に設定
        .TopMargin = xlApp.CentimetersToPoints(2.5)     '上余白を 25 mm に設定
        .BottomMargin = xlApp.CentimetersToPoints(2.5)  '上余白を 25 mm に設定
        .HeaderMargin = xlApp.CentimetersToPoints(1)    'ヘッダーの余白を 10 mm に設定
        .FooterMargin = xlApp.CentimetersToPoints(1)    'フッターの余白を 10 mm に設定
    End With
    xlSheet.PrintOutEx(, , 2)
End Sub

Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click
    Dim xlRange As Excel.Range = Nothing
    For r As Integer = 1 To 80
        For c As Integer = 1 To 15
            xlRange = xlSheet.Range("A1")
            xlRange.Value = Str(r) & "," & Str(c)
        Next
    Next

    '★★ PageSetup を変数に受けてデクリメントする必要がある。
    With xlSheet
        .PageSetup.PrintArea = "A1:H40"
        .PrintOutEx()
    End With
    MRComObject(xlRange)
End Sub

Private Sub Button20_Click(sender As Object, e As EventArgs) Handles Button20.Click
    Dim xlRange As Excel.Range
    Dim xlSheet2 As Excel.Worksheet = CType(xlSheets.Item(2), Excel.Worksheet)
    xlRange = xlSheet.Range("A1")
    xlRange.Activate()

    '★★ CurrentRegion を変数に受けてデクリメントする必要がある。
    xlRange.CurrentRegion.Copy()
    xlSheet2.Select()
    Dim xlRange2 As Excel.Range
    xlRange2 = xlSheet2.Range("A1")
    xlRange2.Select()
    xlRange2.PasteSpecial(Paste:=Excel.XlPasteType.xlPasteAll, _
            Operation:=Excel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, _
                                            SkipBlanks:=False, Transpose:=True)
    xlApp.DisplayAlerts = False   '保存時の問合せのダイアログを非表示に設定
    xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.xls"), FileFormat:=Excel.XlFileFormat.xlExcel8)
    xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.xlsx"), FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbook)
    xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.xlsm"), FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbookMacroEnabled)
    xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.csv"), FileFormat:=Excel.XlFileFormat.xlCSV)
    MRComObject(xlRange)
    MRComObject(xlRange2)
    MRComObject(xlSheet2)
End Sub

３．参考資料等の紹介

上記テストコードの他、Excel Com オブジェクトの解放漏れチェックツール用テストコードでのテスト結果にも掲載

Excel COM オブジェクト及び Com オブジェクト等を返すプロパティ一覧

Excel のプロセスが正常に終了しない理由

４．

５．

６．

検索キーワード及びサンプルコードの別名(機能名)

VBレスキュー(花ちゃん)

VB.NET2003 / Visual Basic2005 / Visual Basic 2008 /
Visual Basic 2010 / Visual Basic 2012 / Visual Basic 2013 /