Excel Com オブジェクトの解放漏れチェックツール用テストコードでのテスト結果

'Excel Com オブジェクトの解放漏れチェックツール(465) のテスト用のコードなので
'動作確認 及び このコード(間違ったコードなので)を使用しないで下さい。
太字でカラーで表示している部分がCom オブジェクトを変数に受けて解放処理が必要な部分です。
'※ から始まる解説の部分は、使用直後のデクリメント漏れとして検出される部分です。


Imports Microsoft.Office.Interop
Imports Microsoft.Office.Core
Imports System.Runtime.InteropServices

Public Class Form1

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 System.Object, e As System.EventArgs) Handles Button1.Click
  Dim xlRange As Excel.Range
  Dim xlCells As Excel.Range

  'Cells プロパティで引数を指定しないとエラーの波線が表示しないが

  xlSheet.Cells.Value = ""

  '引数を指定すると遅延バインデイングを使用できませんのエラーとなり
  'Cells プロパティの使用方法が間違っている事が解るので、開発環境は、Option Strict On で
  '参照設定をして、事前バインディング(アーリーバインディング)で使用して下さい。

  xlSheet.Cells(1, 1).Value = "12"

'上記同様に、Cells プロパティの使用事例
'記事No : 10774
  xlSheet.Cells.SpecialCells(Excel.XlCellType.xlCellTypeLastCell).Select()
  xlSheet.Cells(1, 1) = "abcd"

'記事No : 10470  
  xlSheet.Cells(1, 5) = 0

'記事No:00997
  xlSheet.Cells(1, 1).Borders()

'記事No : 4361
  xlRange = xlCells(1, 1)
  xlRange.Font.Bold = True

  'Cells プロパティは、下記のようにして使用しないと解放漏れになります。
  xlCells = xlSheet.Cells
  xlRange = DirectCast(xlCells.Item(1, 1), Excel.Range)
  Dim xlFont As Excel.Font
  xlFont = xlRange.Font
  xlFont.Bold = True
  MRComObject(xlFont)
  MRComObject(xlRange)
  MRComObject(xlCells)

'記事No : 9246 の事例
  Dim X, Y As Integer
  Dim Z, s As String
'※ ActiveCell 等を変数に受けてデクリメントしないと解放されない。
'  又、ActiveCell プロパティのような不特定のオブジェクトを指すようなプロパティを
'  VB2010 から使用するとトラブルの元になるので使用しない方が望ましい。
  X = xlApp.ActiveCell.Row
  Y = xlApp.ActiveCell.Column
  Z = xlApp.ActiveCell.Address

'Option Strict Off で使用しているのか、変数の型を意識して使用しないと
'Com オブジェクトを変数に個別に受ける事を無視してしまう。
'記事No:01538
  Dim row_cnt As Integer = 0
  If row_cnt > 5 Then
   xlSheet.Rows(row_cnt - 1).Select()
   xlApp.Selection.Copy()
   xlSheet.Rows(row_cnt).Select()
   xlApp.Selection.Insert()
   xlApp.CutCopyMode = False
   xlApp.Selection.ClearContents()
  End If

'記事No:01866
  xlRange = xlCells(1, 11)
  xlRange.Value = "http://xxxxxx.xx.xx"
  xlSheet.Hyperlinks.Add(xlRange, xlRange.Value)
  MRComObject(xlRange)

'記事No:01589
  xlSheets = xlBook.Worksheets
  For i = 1 To xlBook.Sheets.Count()
   Console.WriteLine(xlSheets.Item(i).Name)  'シート名表示
  Next i

End Sub

Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
  '-------------------- マクロの記録を取った場合 ----------------------------
  'ActiveCell.FormulaR1C1 = "あいうえお"
  'Range("A1").Select
  'Selection.Copy
  'Range("D1").Select
  'ActiveSheet.Paste
  '--------------------------------------------------------------------------
 '上記マクロは、下記のように書き換えます。
 'ActiveCell とか Selection とか ActiveSheet のような不特定のものは、VB からは使用しない。
  Dim xlRange As Excel.Range
  xlRange = xlSheet.Range("A1")
  xlRange.Value = "あいうえお"
  xlRange.Copy()   'セル A1 の値をクリップボード上にコピー
  'クリップボード上のテキストをセル D1 へペースト

'※ Range("D1") を変数に受けてデクリメントしないと解放されない。
  xlSheet.Paste(xlSheet.Range("D1"))

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

Private Sub Button5_Click(sender As System.Object, e As System.EventArgs) Handles Button5.Click
  '-------------------- マクロの記録を取った場合 ----------------------------
   '同じ色の場合
   'ActiveCell.FormulaR1C1 = "あいうえお"
   'Range("C2").Select()
   'With Selection.Font
   '  .Color = -16776961
   '  .TintAndShade = 0
   'End With

   '個別に指定する場合
   'Range("E2").Select()
   'ActiveCell.FormulaR1C1 = "あいうえお"
   'With ActiveCell.Characters(Start:=3, Length:=1).Font
   '  .Color = -16776961
   'End With
  '--------------------------------------------------------------------------
  '指定セル内の文字色を全て赤色に設定
  Dim xlRange As Excel.Range

'★ Range("B2") → Range("D2") に変更されたが、Range("B2")のデクリメントがされていない。
  xlRange = xlSheet.Range("B2")
  xlRange.Value = "あいうえお"

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

   .Color = Color.Red
  End With

  '指定セル内の左から3文字目を赤色に設定
  xlRange = xlSheet.Range("D2")
  xlRange.Value = "あいうえお"
  'Debug.Print(TypeName(xlRange.Characters))  'Characters 
  Dim xlCharacters As Excel.Characters
  xlCharacters = xlRange.Characters(Start:=3, Length:=1)

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

  MRComObject(xlCharacters)
  MRComObject(xlRange)
End Sub

Private Sub Button6_Click(sender As System.Object, e As System.EventArgs) Handles Button6.Click
  '-------------------- マクロの記録を取った場合 ----------------------------
   'Range("C2").Select()
   'ActiveCell.FormulaR1C1 = "あいうえお"
   'With ActiveCell.Characters(Start:=3, Length:=1).Font
   '  .Name = "MS 明朝"
   '  .FontStyle = "太字"
   '  .Size = 15
   '  .Strikethrough = False 
   '  .Superscript = False 
   '  .Subscript = False
   '  .OutlineFont = False 
   '  .Shadow = False  、
   '  .Underline = xlUnderlineStyleNone
   '  .ThemeColor = xlThemeColorLight1
   '  .TintAndShade = 0
   '  .ThemeFont = xlThemeFontNone
   'End With
  '--------------------------------------------------------------------------

  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 = "MS 明朝"
   'フォントスタイルを設定(文字列型 (String) の値を使用)
   .FontStyle = "太字 斜体"
   .Size = 15
   .Strikethrough = True   '取り消し線
   .Superscript = False    'True の場合、対象となるフォントが上付き文字になります
   .Subscript = False     'True の場合、対象となるフォントは下付き文字になります
   .OutlineFont = False    'True の場合、フォントをアウトラインフォントにします
   .Shadow = True       'True の場合、フォントを影付きフォントに、
   'フォントに付いている下線の種類を設定()
   .Underline = Excel.XlUnderlineStyle.xlUnderlineStyleSingle
   '指定されたオブジェクトに適用する配色のテーマ(カラーを設定)
   .ThemeColor = Excel.XlThemeColor.xlThemeColorAccent2
   '色を明るく、または暗くする
   .TintAndShade = 0
   '指定されたオブジェクトに適用するテーマのフォントを設定()
   .ThemeFont = Excel.XlThemeFont.xlThemeFontNone
  End With

  MRComObject(xlCharacters)
  MRComObject(xlRange)
End Sub

Private Sub Button7_Click(sender As System.Object, e As System.EventArgs) Handles Button7.Click
  '-------------------- マクロの記録を取った場合 ----------------------------
   'Columns("A:A").Select()
   'Selection.NumberFormatLocal = "@"

   'Columns("B:B").Select()
   'Selection.NumberFormatLocal = "#,##0.0"

   'Columns("C:C").Select()
   'Selection.NumberFormatLocal = "yyyy/mm/dd"
  '--------------------------------------------------------------------------
  Dim xlRange As Excel.Range
'★ Range("A:A") の参照先が変更されたのに、デクリメントがされていない。
  xlRange = xlSheet.Range("A:A")

  xlRange.Select()
  xlRange.NumberFormatLocal = "@"
  xlRange = xlSheet.Range("A2")
  xlRange.Value = "123456.78"
  MRComObject(xlRange)

  xlRange = xlSheet.Range("B:B")
  xlRange.Select()
  xlRange.NumberFormatLocal = "#,##0.0"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("B2")
  xlRange.Value = "123456.78"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("C:C")
  xlRange.Select()
  xlRange.NumberFormatLocal = "yyyy/mm/dd"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("C2")
  xlRange.Value = "4/8"
  MRComObject(xlRange)
End Sub

Private Sub Button8_Click(sender As System.Object, e As System.EventArgs) Handles Button8.Click
  '1.Pictureオブジェクト(隠しオブジェクト)を使っての表示
  Dim myPath As String = System.IO.Path.GetFullPath(".\Test.gif")
  Dim xlRange As Excel.Range
  xlRange = xlSheet.Range("B2")
  Dim myPic As Excel.Pictures
  myPic = CType(xlSheet.Pictures, Excel.Pictures)
  'Excel 2007では画像の挿入位置指定が下記のようにしないと指定できません。
  With myPic.Insert(myPath)
   .Top = CDbl(xlRange.Top)
   .Left = CDbl(xlRange.Left)
  End With
  MRComObject(xlRange)
  MRComObject(myPic)

  '2.Web 上の画像を指定して、Pictureオブジェクト(隠しオブジェクト)を使っての表示
  myPath = "http://www.hanatyan.sakura.ne.jp/toppicture.gif"
  xlRange = xlSheet.Range("I2")
  myPic = CType(xlSheet.Pictures, Excel.Pictures)
  With myPic.Insert(myPath)
   .Top = CDbl(xlRange.Top)
   .Left = CDbl(xlRange.Left)
  End With
  MRComObject(xlRange)
  MRComObject(myPic)

  '3.Web 上の画像を指定して、Shapes.Add メソッドを使っての表示
  Dim myPath1 As String = "http://www.hanatyan.sakura.ne.jp/toppicture.gif"
  Dim xlShapes1 As Excel.Shapes
  Dim xlRange1 As Excel.Range
  xlRange1 = xlSheet.Range("I15")
  xlShapes1 = xlSheet.Shapes
  Dim xlShape1 As Excel.Shape
'★ xlShape1 の参照先が変更されたのに、xlShape1 のデクリメントがされていない。
  xlShape1 = xlShapes1.Item(0)
  '画像のサイズが前もって解らない場合は、適当なサイズで仮取得(縦横共 100ピクセルで)
  xlShape1 = xlShapes1.AddPicture(Filename:=myPath1, _
   LinkToFile:=MsoTriState.msoFalse, SaveWithDocument:=MsoTriState.msoTrue, _
   Left:=CSng(xlRange1.Left), Top:=CSng(xlRange1.Top), Width:=CSng(100), Height:=CSng(100))
  '図のサイズを元のサイズに戻します

'※ この場合は、xlShape1 に続くプロパティ等が赤色で無い事を確認すればいいだけです。
  With xlShape1
   .ScaleHeight(1.0!, MsoTriState.msoTrue)
   .ScaleWidth(1.0!, MsoTriState.msoTrue)
  End With
  MRComObject(xlShape1, True)
  MRComObject(xlShapes1)
  MRComObject(xlRange1)

  '4.クリップボード経由での貼付け
  Dim iData As IDataObject = Clipboard.GetDataObject()
  'クリップボードにBMPファイルがあれば
  If iData.GetDataPresent(DataFormats.Bitmap) = False Then
   'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。
   MessageBox.Show(Me, "クリップボード上に画像がありませんので、すぐにコピーして下さい。")
  End If

  xlRange = xlSheet.Range("M2")
  xlRange.Select()
  xlSheet.Paste()
  MRComObject(xlRange)

 '5.拡大表示(1.25 = 拡大率(1.25倍)で指定)
  Dim xlShapes As Excel.Shapes
  Dim xlShape As Excel.Shape
  xlShapes = xlSheet.Shapes
  xlShape = xlShapes.Item(1)
  xlShape.Select()
  xlShape.ScaleWidth(1.25, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
  xlShape.ScaleHeight(1.25, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
  MRComObject(xlShape, True)

 '6.縮小表示
  xlShape = xlShapes.Item(2)
  xlShape.Select()
  xlShape.ScaleWidth(0.75, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
  xlShape.ScaleHeight(0.75, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
  MRComObject(xlShape)
  MRComObject(xlShapes)
End Sub

Private Sub Button9_Click(sender As System.Object, e As System.EventArgs) Handles Button9.Click
  Dim xlShapes As Excel.Shapes
'★ xlShape1 の参照先が変更されたのに、xlShape1 のデクリメントがされていない。
  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

  '1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '図形を個別に削除する場合

'※ Item を変数に受けてデクリメントする必要がある。
  xlShapes.Item(1).Delete()
  MRComObject(xlShapes)

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


End Sub

Private Sub Button11_Click(sender As System.Object, e As System.EventArgs) Handles Button11.Click
  Call ExcelOpen("", "")   '新規ファイルをオープンして、Excel を起動
  '========================= 列幅を取得・列幅を設定 ============================
  '列幅を取得・列幅を設定・セルの文字列長に合せて列幅を設定する
  '列幅を取得(列幅の単位は、標準スタイルの 1 文字分の幅に相当します。)
  Dim xlRange As Excel.Range

'★ Range("A:X") → Range("B1:D1") に変更されたが、Range("B2")のデクリメントがされていない。
  xlRange = xlSheet.Range("A:X")

  'プロポーショナルフォントでは、数字の 0 の幅が列幅の単位になります)
  MessageBox.Show(Me, xlRange.ColumnWidth.ToString())  '8.38(72ピクセル)

  '列幅を取得(ポイント単位)
  MessageBox.Show(Me, xlRange.Width.ToString())     '1296

  'A列〜X列までの列幅を5に設定
  xlRange.ColumnWidth = 5

  '仮データを入力
  xlRange = xlSheet.Range("B1:D1")
  xlRange.Value = "あいうえおかきくけこ"
  'データの文字列長に合せて列幅を自動調整

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

  MRComObject(xlRange)
  '=============================================================================
  'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
  Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了
  'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
End Sub

Private Sub Button12_Click(sender As System.Object, e As System.EventArgs) Handles Button12.Click
  'テスト用の適当なファイルを用意しておいて下さい。
  '既存のファイルをオープンして、Excel を起動
  Call ExcelOpen(System.IO.Path.GetFullPath("..\..\..\data\DBTest.xls"), "Sheet1")

  '==================== 行の高さを設定・行の高さを自動調整 =====================
  Dim xlRange As Excel.Range
  xlRange = xlSheet.Range("3:10")
  '行の高さを25 ポイント(25/72 インチ)に設定
  xlRange.RowHeight = 25
  '2秒間表示しておく
  System.Threading.Thread.Sleep(2000)
  '行の高さを文字の高さに合せて自動調整

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

  MRComObject(xlRange)
  '=============================================================================
  'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
  Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了
  'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
End Sub

Private Sub Button13_Click(sender As System.Object, e As System.EventArgs) Handles Button13.Click
  Call ExcelOpen("", "")   '新規ファイルをオープンして、Excel を起動

  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

'★ Range("A1:F3") → Range("A1") に変更されたが、Range("B2")のデクリメントがされていない。
  xlRange = xlSheet.Range("A1:F3")  'データの入力セル範囲
  xlRange.Value = Dat                  'セルへデータの入力

  '1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  'データの入力範囲の取得
  '指定のセル位置を含む空白行と空白列に囲まれた最小のセル範囲を取得
  'Activateなセル("A1")があるActivateセル領域を選択します。
  xlRange = xlSheet.Range("A1")
  xlRange.Activate()

'※ CurrentRegion を変数に受けてデクリメントする必要がある。
  xlRange.CurrentRegion.Select()
  '----------------------------------------------
  'Address プロパティでその範囲を A1 形式で取得。
  Dim xlCells As Excel.Range

'※ Cells の使い方が間違っているのでデクリメントができない。
'★ xlCells の参照先が変更されたのに、xlCells のデクリメントがされていない。
  xlCells = CType(xlSheet.Cells(5, 1), Excel.Range)

  xlCells.Value = "セル A1 があるActivateセル領域は " & _
     xlRange.CurrentRegion.Address(False, False, Excel.XlReferenceStyle.xlA1) & " の範囲です。" 'A1:F3
  '----------------------------------------------
  '1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

 'xlSheet 上の使用済みのセル範囲を取得

'※ 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 Button16_Click(sender As System.Object, e As System.EventArgs) Handles Button16.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)
  '---------------------------------------------------------
  '4行目と5行の間に1行挿入します。
  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)
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '4行目と5行の間に1行挿入します。
  '下記の場合は、"A1" のように指定するとセルの挿入になる
'★ Range("**") → Range("**") に変更されたが、Range("**")のデクリメントがされていない。
  xlRange = xlSheet.Range("5:5")
  xlRange.Insert()
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '下記の場合は、"B5" として行の挿入になる
  xlRange = xlSheet.Range("B5")

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

  MRComObject(xlRange, True)
  '------------------ 以上 4行挿入 ---------------------

  '4列目と5列の間に1列挿入します。
  Dim xlColumn As Excel.Range

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

  xlColumn.Insert()
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  xlRange = xlSheet.Range("E:E")
  xlRange.Insert()
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

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

  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  MRComObject(xlColumn, True)
  MRComObject(xlRange, True)
  '------------------ 以上 3列挿入 ---------------------

  'C列の5行目にセルを挿入します。

'★ Range("**") → Range("**") に変更されたが、Range("**")のデクリメントがされていない。
  xlRange = xlSheet.Range("C5")
  xlRange.Insert()
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  'C列の3行目のセルを右に挿入します。
  xlRange = xlSheet.Range("C3")
  xlRange.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftToRight)
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)
  MRComObject(xlRange, True)

'※ Rows.Item を変数に受けてデクリメントする必要がある。
  xlRow = CType(xlSheet.Rows.Item(5), Excel.Range)
  xlRow.Delete()
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

'★ Range("**") → Range("**") に変更されたが、Range("**")のデクリメントがされていない。
  xlRange = xlSheet.Range("5:5")
  xlRange.Delete()
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  xlRange = xlSheet.Range("A5")

'※ EntireRow を変数に受けてデクリメントする必要がある。
  xlRange.EntireRow.Delete()
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)
  MRComObject(xlRow)
  MRComObject(xlRange, True)

  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  'C列の3行目のセルを左に削除します。
  xlRange = xlSheet.Range("C3")
  xlRange.Delete(Shift:=Excel.XlDeleteShiftDirection.xlShiftToLeft)
  '動作確認の為に1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '5列目を削除します。

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

  MRComObject(xlRange)
  xlRange = xlSheet.Range("A5")

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

  xlRange = xlSheet.Range("E:E")
  xlRange.Delete()
  MRComObject(xlRange)
  xlRange = xlSheet.Range("E:E")  '再度指定しないと削除済みなのでエラーとなります。

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

  'C列の5行目にセルを削除します。
  xlRange = xlSheet.Range("C5")
  xlRange.Delete()

  MRComObject(xlColumn, True)
  MRComObject(xlRange)
  '=============================================================================
End Sub

Private Sub Button17_Click(sender As System.Object, e As System.EventArgs) Handles Button17.Click
  '---------------- MS サポート技術情報(文書番号: 259137) -------------------
   'Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
   '  If Not Intersect(Target, Range("MyDefinedRange")) Is Nothing Then
   '    MsgBox(Target.Address & " is in MyDefinedRange.")
   '  Else
   '    MsgBox(Target.Address & " is NOT in MyDefinedRange.")
   '  End If
   'End Sub
  '--------------------------------------------------------------------------
  '指定のセルが、指定のセル範囲内にあるか、どうかを調べる
  Dim xlRange As Excel.Range
  Dim xlTRange As Excel.Range
  xlRange = xlSheet.Range("A1:H20")  '指定のセル範囲内

'★ xlTRange の参照先が変更されたのに、xlTRange のデクリメントがされていない。
  xlTRange = xlSheet.Range("G15")   '指定のセル位置

  'Application.Intersect メソッド : 複数のセル範囲の共有セル範囲を表す Range オブジェクトを返します。
  '共有セル範囲を調べているので、xlTRange と xlRange は入れ替えても同じです。

'※ Intersect を変数に受けてデクリメントする必要がある。
  If Not xlApp.Intersect(xlTRange, xlRange) Is Nothing Then

   'Range.Address プロパティを使って、A1 形式のアドレスを取得
   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 Button18_Click(sender As System.Object, e As System.EventArgs) Handles Button18.Click
  Call ExcelOpen("", "")   '新規ファイルをオープンして、Excel を起動

  '--------------------------------------------------------------------------
  'シート(Worksheet)数の取得
  Dim sheetCount As Integer
'※ Worksheets を変数に受けてデクリメントする必要がある。
  sheetCount = xlBook.Worksheets.Count

  'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。
  MessageBox.Show(Me, "現在のシート(Worksheet)数 = " & sheetCount & " です。")

  '新規にシートを追加
'※ Worksheets を変数に受けてデクリメントする必要がある。
  xlBook.Worksheets.Add()
  sheetCount = xlBook.Worksheets.Count
  MessageBox.Show(Me, "シートを1個追加したので、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)
  '=============================================================================

  'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
  Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了
  'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)

End Sub

Private Sub Button20_Click(sender As System.Object, e As System.EventArgs) Handles Button20.Click
  Call ExcelOpen("", "")   '新規ファイルをオープンして、Excel を起動

  '========================== 表の縦横の合計を求める ===========================
  '仮データの入力
  Dim xlRange As Excel.Range = Nothing
  Dim retValue As Double = 0
  '範囲を変えて試して見て下さい。(セル C3 を含む範囲内で)
  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

  'Activateなセル("C1")があるActivateセル領域を選択します。
  '必ず、表内のセルを指定して下さい。
  xlRange = xlSheet.Range("C3")
  xlRange.Activate()

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

  'セル領域のアドレス(A1:E6)を取得しR1C1 形式のアドレス(1,1,6,5)に変換 
  'A1ToR1C1 関数の実使用例

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

  '範囲の開始位置を整数で求める  A1 → 1,1
  Dim r1 As Integer = r1c1(0)  '1 行
  Dim C1 As Integer = r1c1(1)  '1 列
  '範囲の終了位置を整数で求める E6 → 6,5
  Dim r2 As Integer = r1c1(2)  '6 行
  Dim C2 As Integer = r1c1(3)  '5 列

  '行の合計を求めるセル位置を設定 1,5+1 → F1
  xlRange = xlSheet.Range("A1")
  '行の合計を求める
  xlRange.FormulaR1C1 = "=SUM(RC[-" & CInt(C2 - C1 + 1) & "]:RC[-1])"
  Dim xlRange1 As Excel.Range
  '計算式をコピーする範囲を求める(必ず、別の Range で受けて下さい。)

'★ Range("**") → Range("**") に変更されたが、Range("**")のデクリメントがされていない。
  xlRange1 = xlSheet.Range("A2")
  '計算式を下方向にコピー(xlRange と xlRange1 の使い分けに注目)
  xlRange.AutoFill(Destination:=xlRange1, Type:=Excel.XlAutoFillType.xlFillDefault)
  MRComObject(xlRange)

  '列の合計を求めるセル位置を設定 
  xlRange = xlSheet.Range("B1")
  '列の合計を求める
  xlRange.Formula = "=SUM(R[-" & CInt(r2 - r1 + 1) & "]C:R[-1]C)"
  '計算式をコピーする範囲を求める(必ず、別の Range で受けて下さい。)
  xlRange1 = xlSheet.Range("C1")
  '計算式を下方向にコピー(xlRange と xlRange1 の使い分けに注目)
  xlRange.AutoFill(Destination:=xlRange1, Type:=Excel.XlAutoFillType.xlFillDefault)

  MRComObject(xlRange)
  MRComObject(xlRange1)
  '=============================================================================
End Sub

Private Sub Button21_Click(sender As System.Object, e As System.EventArgs) Handles Button21.Click
  Call ExcelOpen("", "")   '新規ファイルをオープンして、Excel を起動
  '--------------------------------------------------------------------------
  '仮データの書込み
  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

'★ Range("**") → Range("**") に変更されたが、Range("**")のデクリメントがされていない。
  xlRange = xlSheet.Range("B2:B11")
  xlRange.Value = Dat
  '確認のために、2秒間表示しておく
  System.Threading.Thread.Sleep(2000)
  '--------------------------------------------------------------------------

  'B列のデータリストからオートフィルターを使って重複したものを除いたリストだけを抽出

'※ 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 Button22_Click(sender As System.Object, e As System.EventArgs) Handles Button22.Click
  '仮データの入力
  Dim xlRange As Excel.Range = Nothing
  Dim retValue As Double = 0
  '範囲を変えて試して見て下さい。(セル C3 を含む範囲内で)
  For c As Integer = 1 To 5
   For r As Integer = 1 To 6

'★ Range("**") → Range("**") に変更されたが、Range("**")のデクリメントがされていない。
     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()
  'セル領域のアドレス(A1:E6)を取得しR1C1 形式のアドレス(1,1,6,5)に変換 
  'A1ToR1C1 関数の実使用例

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

  '範囲の開始位置を整数で求める  A1 → 1,1
  Dim r1 As Integer = r1c1(0)  '1 行
  Dim C1 As Integer = r1c1(1)  '1 列
  '範囲の終了位置を整数で求める E6 → 6,5
  Dim r2 As Integer = r1c1(2)  '6 行
  Dim C2 As Integer = r1c1(3)  '5 列

  Dim nCount As Integer = 0
  Dim N As Integer = 0
  Dim target As String = "GL"
  Dim xlCharacters As Excel.Characters = Nothing
  For c As Integer = C1 To C2     'C1 列 〜 C2 列までを調べる
   For r As Integer = r1 To r2   'R1 行 〜 R2 行までを調べる
     xlRange = xlSheet.Range("A1")
     Dim myText As String = xlRange.Value.ToString()
     '該当セル内で見つかったら、セル内に複数存在するか調べる
     N = InStr(1, myText, target)
     While N <> 0
      '見つかった文字列の位置
      xlCharacters = xlRange.Characters(Start:=N, Length:=target.Length)

'※ Font を変数に受けてデクリメントする必要がある。
      With xlCharacters.Font
        .Color = Color.Red
        .Bold = True
      End With
      nCount += 1  '見つかった文字列の個数をカウント
      '見つかった位置から再度検索を繰り返す。
      N = InStr(N + 1, myText, target)
     End While
   Next r
  Next c
  MessageBox.Show(Me, "[" & target & "]は、" & nCount.ToString() & " 回見つかりました。")
  MRComObject(xlCharacters)
  MRComObject(xlRange)
End Sub

Private Sub Button23_Click(sender As System.Object, e As System.EventArgs) Handles Button23.Click
  '--------------------------------------------------------------------------
  '何も記入していないと解らないので仮データを記入(R1ToA1 関数の使用例もかねて)
  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")
     '1 〜 100 までのランダムなデータを作成
     xlRange.Value = nRnd.Next(1, 100) ' CInt(100 * Rnd())
   Next r
  Next c
  MRComObject(xlRange, True)  'True でなくても解放はされます。
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)
  '---------------------------------------------------------

  'Range オブジェクトの Sort メソッド を使っての並べ替え
  Dim xlRange1 As Excel.Range
  xlRange1 = xlSheet.Range("B1")
  xlRange = xlSheet.Range("A1:J20")
  'セル範囲 "A1:J20" を B 列をキー(列単位)に降順の並べ替え

'※ この場合、Sort メソッドなので問題ありません。
  xlRange.Sort(Key1:=xlRange1, Order1:=Excel.XlSortOrder.xlDescending, _
                Orientation:=Excel.XlSortOrientation.xlSortColumns)
  MRComObject(xlRange1)
  MRComObject(xlRange)
  '確認のために、3秒間表示しておく
  System.Threading.Thread.Sleep(3000)
  '--------------------------------------------------------------------------


  ' Excel 2007 〜 の Sort オブジェクト を使っての並べ替え
  xlRange1 = xlSheet.Range("B1")
  xlRange = xlSheet.Range("A1:J20")
  'SortFields オブジェクトをすべてクリアします

'※ この場合、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)
   'Sort オブジェクトの開始位置と終了位置を設定します
   .SetRange(xlRange)
   '最初の行にヘッダー情報が含まれるかどうかを指定します
   .Header = Excel.XlYesNoGuess.xlNo  'xlNo 既定値。範囲全体が並べ替えの対象になります。
   '大文字と小文字を区別して検索するには、True に設定します
   .MatchCase = False
   '並べ替え方向を指定します
   .Orientation = Excel.XlSortOrientation.xlSortColumns '列単位で並べ替えます。(xlTopToBottom と同じ)
   '中国語の並べ替え方法を指定します
   .SortMethod = Excel.XlSortMethod.xlPinYin  '中国語の発音表記の順で並べ替えます。これは既定値です
   'コピーした並べ替え書式を適用します。
   .Apply()
  End With
  MRComObject(xlRange1, True)
  MRComObject(xlRange, True)
End Sub

Private Sub Button24_Click(sender As System.Object, e As System.EventArgs) Handles Button24.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
  'Count プロパティでセルの個数を取得

'※ 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
   '指定範囲内のセルの値を1次元配列に確保
   dat(no) = xlRng.Value.ToString()
  Next
  MRComObject(xlRng)
  MRComObject(xlRange)
End Sub

Private Sub Button25_Click(sender As System.Object, e As System.EventArgs) Handles Button25.Click
  'テスト用の適当なファイルを用意しておいて下さい。
  '既存のファイルをオープンして、Excel を起動
  Call ExcelOpen(System.IO.Path.GetFullPath("..\..\..\data\DBTest.xls"), "Sheet1")
  '========================== 既存のファイルを印刷 =============================
  '[ページ設定]ダイアログボックスを表示(参考)
  'xlApp.Dialogs(Excel.XlBuiltInDialog.xlDialogPageSetup).Show()

  '印刷プレビューを表示(参考までに)
  'System.Threading.Thread.Sleep(3000)

  'シートの印刷設定
'※ PageSetup を変数に受けてデクリメントする必要がある。
  With xlSheet.PageSetup
   .PaperSize = Excel.XlPaperSize.xlPaperA4  '用紙サイズをA4
   '印刷の向き 横=xlLandscape   縦 = xlPortrait
   .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

  'シートを印刷   2部印刷
  'PrintOut(From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName, IgnorePrintAreas)
  'PrintOut と同様 Excel 2007 の VBA のヘルプでは見当たらないので、MSDN で調べて下さい。
  xlSheet.PrintOutEx(, , 2)
End Sub

Private Sub Button26_Click(sender As System.Object, e As System.EventArgs) Handles Button26.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

  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)
  MRComObject(xlRange)
End Sub

Private Sub Button29_Click(sender As System.Object, e As System.EventArgs) Handles Button29.Click

  Dim xlRange As Excel.Range
  Dim xlSheet2 As Excel.Worksheet = CType(xlSheets.Item(2), Excel.Worksheet)
  xlRange = xlSheet.Range("A1")
  xlRange.Activate()
  'セル A1 を含むデータ入力範囲をコピー

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

  'コピーしたデータを Sheet2 のセル A1 に行列を入れ替えて貼り付け
  xlSheet2.Select()
  Dim xlRange2 As Excel.Range
  xlRange2 = xlSheet2.Range("A1")
  xlRange2.Select()
  'Range をクリップボードから指定範囲に貼り付けます。
  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

Private Sub Button30_Click(sender As System.Object, e As System.EventArgs) Handles Button30.Click
  Call ExcelOpen("", "")   '新規ファイルをオープンして、Excel を起動
  Dim xlRange As Excel.Range = xlSheet.Range("A1")   '.NET 系の表記
  xlRange.Value2 = 3.14159
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '2.離れた単一セルを参照する場合
  xlRange = xlSheet.Range("A3,D1,C2")
  xlRange.Value = 12345
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '3.セル範囲を参照する場合その1
  xlRange = xlSheet.Range("A1:C3")
  xlRange.Select()
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '下記でも同じ事です。
  xlRange = xlSheet.Range("A1", "D4")
  xlRange.Select()
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '4.離れたセル範囲を参照する場合その2
  xlRange = xlSheet.Range("A1:C3,A6:C9,E1:H4")
  xlRange.Select()
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '5.1列全体を参照する場合
  xlRange = xlSheet.Range("C:C")
  xlRange.Select()
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '6.複数列全体を参照する場合
  xlRange = xlSheet.Range("C:D, F:F, H:H")
  xlRange.Select()
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '7.1行全体を参照する場合
  xlRange = xlSheet.Range("2:2")
  xlRange.Select()
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '8.複数行全体を参照する場合
  xlRange = xlSheet.Range("4:6, 9:10, 12:12")
  xlRange.Select()
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '9.Worksheet.Cells プロパティを使って全セルを参照する
  Dim xlCells As Excel.Range = xlSheet.Cells
  xlCells.Select()
  MRComObject(xlCells)

  '-------------------------------------------------------------------------------
  '上記操作をVB2010用に書き換えると
  Dim xlCells1 As Excel.Range = xlSheet.Cells
  'できるだけ下記のような使い方をしないで下さい。
  Dim xlRange1 As Excel.Range = xlSheet.Range(xlCells1(1, 1), xlCells1(5, 3))
  '上記は、下記のようにした方が無難です。
  Dim xlFont As Excel.Font = xlRange1.Font
  xlFont.Italic = True
  MRComObject(xlFont)
  MRComObject(xlRange1)
  MRComObject(xlCells1)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '11.セルに値を設定する
  'Value プロパティとValue2 プロパティの違いは、通貨型及び日付型のデータを使用しない事です
  xlRange = xlSheet.Range("A1")
  xlRange.Value = System.DateTime.Now
  Dim xlOffsetRange As Excel.Range
  xlOffsetRange = xlRange.Offset(1)
  xlOffsetRange.Value2 = System.DateTime.Now
  MRComObject(xlOffsetRange)
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '12.セルの値を取得する
  xlRange = xlSheet.Range("A1")
  Debug.Print(xlRange.Value.ToString)       '2012/05/11 11:50:07
  xlOffsetRange = xlRange.Offset(1)
  xlOffsetRange.NumberFormatLocal = "yyyy/mm/dd hh:MM:ss"
  Debug.Print(xlOffsetRange.Value2.ToString) '41040.4931328588
  Debug.Print(xlOffsetRange.Value.ToString)  '2012/05/11 11:50:06
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)
  MRComObject(xlOffsetRange)
  MRComObject(xlRange)

  '13.セルに数式を設定する
  'Range.Formula プロパティは、数式を、A1 参照形式で、取得、又は設定します。
  xlRange = xlSheet.Range("C1")
  xlRange.Value = 123
  xlOffsetRange = xlRange.Offset(ColumnOffset:=1)
  xlOffsetRange.Value = 321
  MRComObject(xlRange)
  xlRange = xlSheet.Range("E1")
  xlRange.Formula = "=C1+D1"
  MRComObject(xlOffsetRange)
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '14.セルの数式を取得する
  xlRange = xlSheet.Range("E1")
  Debug.Print(xlRange.Value.ToString)       '444
  Debug.Print(xlRange.Formula.ToString)      '=C1+D1
  MRComObject(xlRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '15.AutoFill メソッドを使ってセルに連続してデータを入力する
  'AutoFill メソッド : 指定された対象セル範囲内のセルに対してオートフィルを実行します。
  xlRange = xlSheet.Range("A1")
  xlRange.Value = "1月"
  xlRange1 = xlSheet.Range("A1:L1")
  'セル A1 〜 L1 まで、1月 〜 12月 と入力します。
  '下記のように直接範囲(xlSheet.Range("A1:L1"))を指定しない事
  'xlRange.AutoFill(Destination:=xlSheet.Range("A1:L1"), Type:=Excel.XlAutoFill ...)
  xlRange.AutoFill(Destination:=xlRange1, Type:=Excel.XlAutoFillType.xlFillMonths)
  MRComObject(xlRange1)
  MRComObject(xlRange)
End Sub

Private Function A1ToR1C1(ByVal A1 As String) As Integer()
'A1形式をR1C1形式に変換する関数(Excel の Address 関数を使った方法)
  Dim adr1 As String = "A1"
  Dim adr2 As String = "A1"
  Dim r1c1(3) As Integer
  If A1.IndexOf(":") > 0 Then
   Dim wrk() As String = A1.Split(":"c)
   adr1 = wrk(0)
   adr2 = wrk(1)
  Else
   adr1 = A1
   adr2 = "A1"
  End If
  Dim xlRange As Excel.Range

'★ Range("**") → Range("**") に変更されたが、Range("**")のデクリメントがされていない。
  xlRange = xlSheet.Range(adr1)
  Dim Col() As String = xlRange.Address(True, True, _
           Excel.XlReferenceStyle.xlR1C1).Replace("R", "").Split("C"c)
  r1c1(0) = CInt(Col(0))
  r1c1(1) = CInt(Col(1))
  xlRange = xlSheet.Range(adr2)
  Dim Col1() As String = xlRange.Address(True, True, _
           Excel.XlReferenceStyle.xlR1C1).Replace("R", "").Split("C"c)
  r1c1(2) = CInt(Col1(0))
  r1c1(3) = CInt(Col1(1))
  MRComObject(xlRange)
  Return r1c1
End Function

Private Sub Button32_Click(sender As System.Object, e As System.EventArgs) Handles Button32.Click
  Call ExcelOpen("", "")   '新規ファイルをオープンして、Excel を起動

  MessageBox.Show(Me, "セル A1 〜 A4 の範囲に(Range.Clear)を試したいデータ" & _
                     "(数式・書式・文字)等を入力して下さい。")
  Dim xlRange As Excel.Range = xlSheet.Range("A1:A4")
  xlRange.Clear()
  MRComObject(xlRange)

  '・Range.ClearContents メソッド(選択範囲から数式と文字を削除します。)
  '指定のシートの指定のセル範囲の書式設定を残して、数式と文字を削除します。
  MessageBox.Show(Me, "セル A1 〜 A4 の範囲に(ClearContents)を" & _
               "試したいデータ(数式・書式・文字)等を入力して下さい。")
  xlRange = xlSheet.Range("A1:A4")
  xlRange.ClearContents()
  MRComObject(xlRange)

  '・Range.ClearFormats メソッド(オブジェクトの書式設定を削除します。)
  '指定のシートの指定のセル範囲のすべての書式設定を削除します。(数式やデータは削除されません。)
  MessageBox.Show(Me, "セル A1 〜 A4 の範囲に(ClearFormats)を" & _
               "試したいデータ(数式・書式・文字)等を入力して下さい。")
  xlRange = xlSheet.Range("A1:A4")
  xlRange.ClearFormats()
  MRComObject(xlRange)


  '仮データの入力
  Dim xlRangeDat As Excel.Range = Nothing
  Dim n As Integer = 0
  For r As Integer = 1 To 10
   For c As Integer = 1 To 5
     n += 1
     xlRangeDat = xlSheet.Range("A1")
     xlRangeDat.Value = n
   Next
  Next
  MRComObject(xlRangeDat)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '2.セル(セル範囲)をコピー及び貼り付ける
  Dim xlCopyRange As Excel.Range = xlSheet.Range("B2")
  Dim xlDestRange As Excel.Range = xlSheet.Range("G2")
  xlCopyRange.Copy(Destination:=xlDestRange)
  MRComObject(xlCopyRange)
  MRComObject(xlDestRange)

  '3.セル(表全体)をコピー及び貼り付ける
'★ xlCopyRange の参照先が変更されたのに、xlCopyRange のデクリメントがされていない。
  xlCopyRange = xlSheet.Range("B2")
  xlCopyRange = xlCopyRange.CurrentRegion
  xlDestRange = xlSheet.Range("A15")
  xlCopyRange.Copy(Destination:=xlDestRange)
  MRComObject(xlCopyRange)
  MRComObject(xlDestRange)

  '4.セル(セル範囲)を移動する
'★ xlCopyRange の参照先が変更されたのに、xlCopyRange のデクリメントがされていない。
  xlCopyRange = xlSheet.Range("C3")
  xlDestRange = xlSheet.Range("H3")
  xlCopyRange.Cut(Destination:=xlDestRange)
  MRComObject(xlCopyRange)
  MRComObject(xlDestRange)

  '6.形式を選択して貼り付け
  xlRange = xlSheet.UsedRange
  xlRange.Clear()
  MRComObject(xlRange)
  n = 0
  For r As Integer = 1 To 5
   For c As Integer = 1 To 5
     n += 1
     xlRangeDat = xlSheet.Range("A1")
     xlRangeDat.Value = n
   Next
  Next
  MRComObject(xlRangeDat)

  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)
  xlRange = xlSheet.Range("A1:F6")
  'Excel をアクティブにする(エクセルにフォーカスを移す。)
  AppActivate(xlApp.Caption)  '必要ありませんが、見た目にわかりやすくする為に
  xlRange.Select()
  SendKeys.SendWait("%+(=)")
  MRComObject(xlRange)

'★ xlCopyRange の参照先が変更されたのに、xlCopyRange のデクリメントがされていない。
  'そもそも、xlCopyRange の使用方法が間違っている
  xlCopyRange = xlSheet.Range("B2")
  xlCopyRange = xlCopyRange.CurrentRegion
  xlCopyRange.Copy()
  MRComObject(xlCopyRange)

  xlDestRange = xlSheet.Range("A10")
  xlDestRange.PasteSpecial(Excel.XlPasteType.xlPasteValues)
  MRComObject(xlDestRange)
  '確認のために、1秒間表示しておく
  System.Threading.Thread.Sleep(1000)

  '7.セルのエラー値を取得する
  'xlRange = xlSheet.UsedRange
  'xlRange.Clear()

  'Excel 上にエラーを発生(生成)させる
  xlRange = xlSheet.Range("A1") : xlRange.Formula = "#DIV/0!"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("A2") : xlRange.Formula = "#N/A"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("A3") : xlRange.Formula = "#NAME?"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("A4") : xlRange.Formula = "#NULL!"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("A5") : xlRange.Formula = "#NUM!"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("A6") : xlRange.Formula = "#REF!"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("A7") : xlRange.Formula = "#VALUE!"
  MRComObject(xlRange)
  xlRange = xlSheet.Range("A8") : xlRange.Value = CDec("1234567890123")

'※ この場合、Style オブジェクトでなく、Style プロパティなので、解放処理は必要ありません。
  xlRange.Style = "Currency [0]"

  xlRange.ColumnWidth = 8
  MRComObject(xlRange)

  Dim xlFunction As Excel.WorksheetFunction = xlApp.WorksheetFunction
  For r As Integer = 1 To 10
   For c As Integer = 1 To 3
     xlRangeDat = xlSheet.Range("A1")
     If xlFunction.IsError(xlRangeDat) Then
      'セル上のエラーの発生場所とエラーの種類を取得
      Debug.Print(" R" & r.ToString & ", C" & c.ToString & " で " & _
      xlRangeDat.Text.ToString & vbTab & "(" & xlRangeDat.Value.ToString & _
                             ") のエラーが発生しました。")
      'エラーが表示しているセルの書式設定を残して、数式と文字を削除(お好みで)
      xlRangeDat.ClearContents()
     End If
     '文字数に対して表示列幅が不足して[####]のように表示しているセルを改善。
     If xlRangeDat.Text.ToString.Length > 3 AndAlso _
                  xlRangeDat.Text.ToString.Substring(0, 3) = "###" Then
      'データの文字列長に合せて列幅を自動調整
      xlRange = xlRangeDat.Columns
      xlRange.AutoFit()
      MRComObject(xlRange)
     End If
   Next
  Next
  MRComObject(xlRangeDat)
  MRComObject(xlFunction)
End Sub

Private Sub ExcelOpen(ByVal FilePath As String, ByVal SheetName As String)
  xlApp = New Excel.Application
  xlBooks = xlApp.Workbooks
  If FilePath.Length = 0 Then
   xlBook = xlBooks.Add
   xlSheets = xlBook.Worksheets
   xlSheet = CType(xlSheets.Item(1), Excel.Worksheet)
  Else
   xlBook = xlBooks.Open(FilePath)
   xlSheets = xlBook.Worksheets
   xlSheet = CType(xlSheets(SheetName), Excel.Worksheet)
  End If
  xlApp.Visible = True
End Sub

Private Sub ExcelClose(ByVal FilePath As String, Optional ByVal CancelSave As Boolean = True)
  xlApp.DisplayAlerts = False  '保存時の問合せのダイアログを非表示に設定
  If CancelSave Then
  End If
  MRComObject(xlSheet)     'xlSheet の解放
  MRComObject(xlSheets)     'xlSheets の解放
  xlBook.Close()        'xlBook を閉じる
  MRComObject(xlBook)      'xlBook の解放
  MRComObject(xlBooks)     'xlBooks の解放
  xlApp.Quit()         'Excelを閉じる
  MRComObject(xlApp)      'xlApp を解放
End Sub

Public Shared Sub MRComObject(Of T As Class)(ByRef objCom As T, Optional ByVal force As Boolean = False)
  System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom)
  objCom = Nothing
End Sub

End Class



2012/07/01


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

VB.NET2003/VB2005/VB2008/VB2010
Excel 2007/Excel 2010/Excel VBA