|
'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
'指定セル内の左から３文字目を赤色に設定
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 = "ＭＳ 明朝"
' .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 = "ＭＳ 明朝"
'フォントスタイルを設定(文字列型 (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
'１．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)
'２．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)
'３．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)
'４．クリップボード経由での貼付け
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)
'５．拡大表示（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)
'６．縮小表示
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列目と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)
'------------------ 以上 ３列挿入 ---------------------
'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, "シートを１個追加したので、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
'確認のために、２秒間表示しておく
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 でなくても解放はされます。
'確認のために、１秒間表示しておく
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)
'確認のために、３秒間表示しておく
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
'指定範囲内のセルの値を１次元配列に確保
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 '用紙サイズをＡ４
'印刷の向き 横=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
'確認のために、１秒間表示しておく
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)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'２．離れた単一セルを参照する場合
xlRange = xlSheet.Range("A3,D1,C2")
xlRange.Value = 12345
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'３．セル範囲を参照する場合その１
xlRange = xlSheet.Range("A1:C3")
xlRange.Select()
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'下記でも同じ事です。
xlRange = xlSheet.Range("A1", "D4")
xlRange.Select()
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'４．離れたセル範囲を参照する場合その２
xlRange = xlSheet.Range("A1:C3,A6:C9,E1:H4")
xlRange.Select()
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'５．1列全体を参照する場合
xlRange = xlSheet.Range("C:C")
xlRange.Select()
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'６．複数列全体を参照する場合
xlRange = xlSheet.Range("C:D, F:F, H:H")
xlRange.Select()
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'７．1行全体を参照する場合
xlRange = xlSheet.Range("2:2")
xlRange.Select()
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'８．複数行全体を参照する場合
xlRange = xlSheet.Range("4:6, 9:10, 12:12")
xlRange.Select()
MRComObject(xlRange)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'９．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)
'確認のために、１秒間表示しておく
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)
'確認のために、１秒間表示しておく
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
'確認のために、１秒間表示しておく
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)
'確認のために、１秒間表示しておく
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)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'15．AutoFill メソッドを使ってセルに連続してデータを入力する
'AutoFill メソッド : 指定された対象セル範囲内のセルに対してオートフィルを実行します。
xlRange = xlSheet.Range("A1")
xlRange.Value = "１月"
xlRange1 = xlSheet.Range("A1:L1")
'セル A1 〜 L1 まで、１月 〜 １２月 と入力します。
'下記のように直接範囲(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)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'２．セル(セル範囲)をコピー及び貼り付ける
Dim xlCopyRange As Excel.Range = xlSheet.Range("B2")
Dim xlDestRange As Excel.Range = xlSheet.Range("G2")
xlCopyRange.Copy(Destination:=xlDestRange)
MRComObject(xlCopyRange)
MRComObject(xlDestRange)
'３．セル(表全体)をコピー及び貼り付ける
'★ xlCopyRange の参照先が変更されたのに、xlCopyRange のデクリメントがされていない。
xlCopyRange = xlSheet.Range("B2")
xlCopyRange = xlCopyRange.CurrentRegion
xlDestRange = xlSheet.Range("A15")
xlCopyRange.Copy(Destination:=xlDestRange)
MRComObject(xlCopyRange)
MRComObject(xlDestRange)
'４．セル(セル範囲)を移動する
'★ xlCopyRange の参照先が変更されたのに、xlCopyRange のデクリメントがされていない。
xlCopyRange = xlSheet.Range("C3")
xlDestRange = xlSheet.Range("H3")
xlCopyRange.Cut(Destination:=xlDestRange)
MRComObject(xlCopyRange)
MRComObject(xlDestRange)
'６．形式を選択して貼り付け
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)
'確認のために、１秒間表示しておく
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)
'確認のために、１秒間表示しておく
System.Threading.Thread.Sleep(1000)
'７．セルのエラー値を取得する
'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
|