VBレスキュー(花ちゃん)
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ各掲示板

メニューへ戻ります。 Excel・Word・VBA関係のメニュー
１．VB2013 から Excel 2013 を操作する為の基本的な操作方法
２．Excel 操作ワンポイントテクニック集その１
３．Excel 操作ワンポイントテクニック集その２
４．VB2013から Excel にデータを送りグラフを表示する
５．Excel のグラフをクリップボード経由で PictureBox に貼付
６．Excel 2013 の WEB クエリを VB2013 から操作する
７．
８．
９．
10．
11．VB2013から Word の起動・終了処理及び文字の書き込み例
12．Wordの差し込み印刷機能を使って宛て名ラベルを印刷
13．
20．その他、当サイト内に掲載のExcel・Word・VBAに関するサンプル


３．Excel 操作ワンポイントテクニック集その２(09_Xls_03)　(旧、SampleNo.460)
１ ．Excel の指定列のデータから重複しないデータを抽出
２ ．選択範囲内で指定文字を連続検索
３ ．VB2013 から Excel の並べ替え(ソート)を実行する
４ ．VB2013 から Excel のシートの指定の範囲のデータを取得
５ ．VB2013 から Excel の既存のファイルを印刷
６ ．VB2013 から Excel のシートの指定範囲を印刷する
７ ．VB2013 から Excel の印刷プレビューの画面を閉じる
８ ．Excel 2013 で印刷中のダイアログを非表示にして印刷(テスト版)
９ ．Excel 2013 で行列を入れ替え及び型式を指定して保存
10．VB2013 から Excel のセルに関する操作、1行 Tips 集その１
11．VB2013 から Excel のセルに関する操作、1行 Tips 集その２
12．VB2013 から Excel のセルに関する操作、1行 Tips 集その３
13．VB2013 から Excel の表示処理速度を向上テスト
14．VB2013から Excel のマクロを作成し実行する
15．Addressプロパティの使用例
16．シートの指定範囲内を検索
17．自作関数を使って罫線を描画
18．Excel の Speech.Speak での音声読み上げ
19．Excel の GetPhonetic メソッドを使ってのふりがなを取得
20．

※　起動及び終了処理及び使用関数等の記載が漏れていたらExcel 操作ワンポイントテクニック集その１(09_Xls_02)の方をご覧下さい。
　下記プログラムコードに関する補足・注意事項　
動作確認：Windows 8.1 (Windows 7) / VB2013 (VB2010) / Framework 4.5.1 / 対象の CPU：x86 / Excel 2013
Option　：[Compare Text] [Explicit On] [Infer On] [Strict On]
Imports ：Microsoft.Office.Interop / System.Runtime.InteropServices
参照設定：Microsoft Excel 15.0 Object Library / WaitTime.dll　　　参照設定方法参照
使用コン：Button21 〜 Button39 TextBox1 TextBox2 　BackgroundWorker1　BackgroundWorker2
トロール：
このサンプル等の内容を無断で転載、掲載、配布する事はお断りします。(私の修正・改訂・削除等が及ばなくなるので)
必要ならリンクをはるようにして下さい。(引用の場合は引用元のリンクを明記して下さい)
このページのトップへ移動します。 １．Excel の指定列のデータから重複しないデータを抽出

'追加
Private title As String
Private sleepTime As Integer

Private Sub Button21_Click(sender As Object, e As 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
　　xlRange = xlSheet.Range("B2:B11")
　　xlRange.Value = Dat
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)
　　'--------------------------------------------------------------------------

　　'B列のデータリストからオートフィルターを使って重複したものを除いたリストだけを抽出
　　xlRange = xlSheet.Range("B2:B11")
　　Dim xlRange1 As Excel.Range
　　xlRange1 = xlSheet.Range("B2")
　　xlRange.AdvancedFilter(Excel.XlFilterAction.xlFilterInPlace, xlRange1, , True)
　　MRComObject(xlRange)

　　'抽出したデータ件数を取得
　　xlRange = xlSheet.Range("B2")
　　Dim xlEndRange As Excel.Range
　　xlEndRange = xlRange1.End(Excel.XlDirection.xlDown)
　　Dim Count, i As Integer
　　Count = xlEndRange.Row
　　MRComObject(xlEndRange)
　　MRComObject(xlRange1)
　　MRComObject(xlRange)

　　ListBox1.Items.Clear()
　　For i = 3 To Count
　　　　xlRange = xlSheet.Range(R1ToA1(i, 2))
　　　　If CInt(xlRange.RowHeight) > 0 Then
　　　　　　'抽出したデータを取得
　　　　　　ListBox1.Items.Add(xlRange.Value.ToString)
　　　　End If
　　　　MRComObject(xlRange)
　　Next i
　　'確認のために、3秒間表示しておく
　　WT.WaitTime(3000)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 ２．選択範囲内で指定文字を連続検索

Private Sub Button22_Click(sender As Object, e As EventArgs) Handles Button22.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(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　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()
　　'指定のセル位置を含む空白行と空白列に囲まれた最小のセル範囲を取得
　　Dim xlCurrentRegion As Excel.Range
　　xlCurrentRegion = xlRange.CurrentRegion
　　xlCurrentRegion.Select()
　　'セル領域のアドレス(A1:E6)を取得しR1C1 形式のアドレス(1,1,6,5)に変換　
　　'A1ToR1C1 関数の実使用例
　　Dim r1c1() As Integer = A1ToR1C1(xlCurrentRegion.Address( _
　　　　　　　　　　　　　　　　　　False, False, Excel.XlReferenceStyle.xlA1))
　　MRComObject(xlCurrentRegion)
　　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 列
　　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(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　Dim myText As String = xlRange.Value.ToString()
　　　　　　'該当セル内で見つかったら、セル内に複数存在するか調べる
　　　　　　N = InStr(1, myText, target)
　　　　　　While N <> 0
　　　　　　'見つかった文字列の位置
　　　　　　xlCharacters = xlRange.Characters(Start:=N, Length:=target.Length)
　　　　　　'見つかった文字列を赤色で太字で表示
　　　　　　Dim xlFont As Excel.Font
　　　　　　xlFont = xlCharacters.Font
　　　　　　With xlFont
　　　　　　　　.Color = Color.Red
　　　　　　　　.Bold = True
　　　　　　End With
　　　　　　MRComObject(xlFont)
　　　　　　MRComObject(xlCharacters)
　　　　　　nCount += 1　　'見つかった文字列の個数をカウント
　　　　　　'見つかった位置から再度検索を繰り返す。
　　　　　　N = InStr(N + 1, myText, target)
　　　　　　End While
　　　　　　MRComObject(xlRange)
　　　　Next r
　　Next c
　　MessageBox.Show(Me, "[" & target & "]は、" & nCount.ToString() & " 回見つかりました。")

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 ３．VB2013 から Excel の並べ替え(ソート)を実行する

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

　　'============================= 並べ替え(ソート) ==============================
　　'何も記入していないと解らないので仮データを記入(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(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　'1 〜 100 までのランダムなデータを作成
　　　　　　xlRange.Value = nRnd.Next(1, 100)　' CInt(100 * Rnd())
　　　　　　MRComObject(xlRange)
　　　　Next r
　　Next c
　　'確認のために、１秒間表示しておく
'　　WT.WaitTime(1000)
　　 MessageBox.Show(Me, "セル範囲 A1:J20 を B 列をキー(列単位)に降順の並べ替え")
　　'---------------------------------------------------------

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

　　 MessageBox.Show(Me, "次に、セル範囲 A1:J20 を A 列をキー(列単位)に昇順に並べ替えます。")
　　'--------------------------------------------------------------------------

　　' Excel 2007 〜 の Sort オブジェクト を使っての並べ替え
　　'　 --------------------- マクロの記録を取った場合 ---------------------------
　　　　'　　ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
　　　　'　　ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B20") _
　　　　'　　　　, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
　　　　'　　With ActiveWorkbook.Worksheets("Sheet1").Sort
　　　　'　　　　.SetRange Range("A1:J20")
　　　　'　　　　.Header = xlGuess
　　　　'　　　　.MatchCase = False
　　　　'　　　　.Orientation = xlTopToBottom
　　　　'　　　　.SortMethod = xlPinYin
　　　　'　　　　.Apply
　　　　'　　End With
　　'--------------------------------------------------------------------------
　　xlRange1 = xlSheet.Range("A1")
　　xlRange = xlSheet.Range("A1:J20")
　　Dim xlSort As Excel.Sort
　　Dim xlSortFields As Excel.SortFields
　　xlSort = xlSheet.Sort

　　xlSortFields = xlSort.SortFields
　　Dim xlSortFields1 As Excel.SortField = Nothing
　　With xlSortFields
　　　　.Clear()　'SortFields オブジェクトをすべてクリアします
　　　　'新しい並べ替えの条件を作成
　　　　'Key:並べ替える基準のセル　SortOn:並べ替えの基準(値・セルの色等)
　　　　'Order: 並べ替えの順序(昇順・降順)　 CustomOrder:ユーザー定義の並べ替えの順序
　　　　'DataOption:数値とテキストの並べ替えの選択

　　　　'B 列を基準に、値 を基準に、昇順で、テキストを数値データとして並べ替えます。
　　　　'SortFields.Add メソッド は、新しい並べ替えフィールドを作成し、SortFields オブジェクトを返すので
　　　　'変数に受けて解放してやらないとプロセスが終了しません。(ただ、このような使い方が正しいのかは、疑問)
　　　　xlSortFields1 = .Add(Key:=xlRange1, SortOn:=Excel.XlSortOn.xlSortOnValues, _
　　　　　　　　　　　　Order:=Excel.XlSortOrder.xlAscending, _
　　　　　　　　　　　　DataOption:=Excel.XlSortDataOption.xlSortTextAsNumbers)
　　　　'Sort オブジェクトの開始位置と終了位置を設定します
　　　　xlSort.SetRange(xlRange)
　　　　'最初の行にヘッダー情報が含まれるかどうかを指定します
　　　　xlSort.Header = Excel.XlYesNoGuess.xlNo　　'範囲全体が並べ替えの対象になります。
　　　　'大文字と小文字を区別して検索するには、True に設定します
　　　　xlSort.MatchCase = False
　　　　'並べ替え方向を指定します
　　　　xlSort.Orientation = Excel.XlSortOrientation.xlSortColumns　'列単位で並べ替え
　　　　'中国語の並べ替え方法を指定します
　　　　xlSort.SortMethod = Excel.XlSortMethod.xlPinYin　'中国語の発音表記の順で並べ替え
　　　　'コピーした並べ替え書式を適用します。
　　　　xlSort.Apply()
　　End With
　　MRComObject(xlRange)
　　MRComObject(xlSortFields1)
　　MRComObject(xlSortFields)
　　MRComObject(xlSort)
　　MRComObject(xlRange1)
　　'確認のために、３秒間表示しておく
　　WT.WaitTime(3000)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 ４．VB2013 から Excel のシートの指定の範囲のデータを取得

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

　　'===================== シートの指定の範囲のデータを取得 ======================
　　TextBox1.Text = ""
　　ListBox1.Items.Clear()
　　'仮データの入力
　　Dim xlRange As Excel.Range = Nothing
　　For r As Integer = 1 To 20
　　　　For c As Integer = 1 To 10
　　　　　　xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　xlRange.Value = Str(r) & "," & Str(c)
　　　　　　MRComObject(xlRange)
　　　　Next
　　Next

　　'データを取得したい範囲を設定
　　xlRange = xlSheet.Range("B3:D10")
　　'クリップボードにコピーする場合
　　xlRange.Copy()
　　'Count プロパティでセルの個数を取得
　　Dim xlCells As Excel.Range
　　xlCells = xlRange.Cells
　　Dim n As Integer = xlCells.Count
　　MRComObject(xlCells)

　　Dim dat(n - 1) As String
　　Dim no As Integer = -1
　　Dim xlElement As Excel.Range = Nothing
　　For Each xlElement In xlRange
　　　　no += 1
　　　　'指定範囲内のセルの値を１次元配列に確保
　　　　dat(no) = xlElement.Value.ToString()
　　　　MRComObject(xlElement)
　　Next
　　MRComObject(xlRange)

　　'取得したデータを表示
　　'VB のリストボックスに表示する場合
　　ListBox1.Items.AddRange(dat)

　　'Debug.Print で表示
　　For i As Integer = 0 To n - 1
　　　　Debug.Print(dat(i))
　　Next

　　'VB のテキストボックスに表示
　　Dim iData As IDataObject = Clipboard.GetDataObject()
　　'クリップボードにテキストデータがあれば
　　If iData.GetDataPresent(DataFormats.Text) Then
　　　　TextBox1.Text = DirectCast(iData.GetData(DataFormats.UnicodeText), String)
　　End If
　　'確認のために、３秒間表示しておく
　　WT.WaitTime(3000)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 ５．VB2013 から Excel の既存のファイルを印刷

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

　　'========================== 既存のファイルを印刷 =============================
　　'［ページ設定］ダイアログボックスを表示（参考）
　　'xlApp.Dialogs(Excel.XlBuiltInDialog.xlDialogPageSetup).Show()

　　'印刷プレビューを表示（参考までに）
　　'xlSheet.PrintPreview()

　　'シートの印刷設定
　　Dim xlPageSetup As Excel.PageSetup
　　xlPageSetup = xlSheet.PageSetup
　　With xlPageSetup
　　　　.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)
　　MRComObject(xlPageSetup)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(3000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 ６．VB2013 から Excel のシートの指定範囲を印刷する

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

　　'=========================== 指定範囲を印刷する ==============================
　　'仮データの入力
　　Dim xlRange As Excel.Range = Nothing
　　For r As Integer = 1 To 80
　　　　For c As Integer = 1 To 15
　　　　　　xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　xlRange.Value = Str(r) & "," & Str(c)
　　　　　　MRComObject(xlRange)
　　　　Next
　　Next

　　'指定範囲を格子で罫線を引く(指定範囲を印刷する事とは関係ありません)
　　Call SetLine(1, 1, 40, 8, Excel.XlLineStyle.xlContinuous, Excel.XlBorderWeight.xlThin, 0)
　　'確認のために、２秒間表示しておく
　　WT.WaitTime(2000)

　　Dim xlPageSetup As Excel.PageSetup
　　xlPageSetup = xlSheet.PageSetup
　　xlPageSetup.PrintArea = "A1:H40"
　　xlSheet.PrintOutEx()
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)
　　MRComObject(xlPageSetup)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 ７．VB2013 から Excel の印刷プレビューの画面を閉じる

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

　　'======================= 印刷プレビューの画面を閉じる ========================
　　'仮データの入力
　　Dim xlRange As Excel.Range = Nothing
　　For r As Integer = 1 To 80
　　　　For c As Integer = 1 To 15
　　　　　　xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　xlRange.Value = Str(r) & "," & Str(c)
　　　　　　MRComObject(xlRange)
　　　　Next
　　Next
　　'--------------------------------------------------------------------------
　　'現在表示している Excel のタイトルを取得する
　　title = xlApp.Caption
　　sleepTime = 3000　　 '指定ミリ秒後に BackgroundWorker を実行する
　　'バックグラウンド操作の実行を開始
　　'指定時間後に別スレッドから印刷プレビューの画面を閉じる
　　Me.BackgroundWorker1.RunWorkerAsync()
　　'印刷プレビューを表示する
　　xlSheet.PrintPreview()

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

'別途、ツールボックスから BackgroundWorker1 を貼り付けておいて下さい。
Private Sub BackgroundWorker1_DoWork(ByVal sender As Object, ByVal e As　_
　　　　　　System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
　　'指定時間操作の開始を待つ
　　WT.WaitTime(sleepTime)

　　Dim hwnd As IntPtr
　　'タイトル名を指定して Excel のウィンドウハンドルを取得
　　hwnd = FindWindowEx(IntPtr.Zero, IntPtr.Zero, vbNullString, title)
　　'AppActivate(title)　 '前面に表示するでもいいが、後の事も考えて
　　'現在使用している Excel をアクティブにする
　　SetForegroundWindow(hwnd)

　　'Excel に Excel のショートカットキーを送る
　　'簡便的に SendKeys を使って
　　'SendKeys.SendWait("{ESC}")

　　'できれば、下記の SendInput 関数を使った方法でキーを送信して下さい。
　　' http://hanatyan.sakura.ne.jp/patio/read.cgi?no=245
　　Dim ki As New SendInput2013.Class1
　　ki.KeyReSet()　　　　　　　　　　　　　　　　　　　 'キー操作の初期化
　　'閉じる場合(ESC キーを押す 又は、Ctr + C でも同じ)
　　ki.KeyDown(Keys.Escape)　　　　　　　　　　　　　　 'ESC キーを押す
　　ki.KeyUP(Keys.Escape)　　　　　　　　　　　　　　　 'ESC キーを放す
　　ki.KeyStroke()　　　　　　　　　　　　　　　　　　　'上記一連のキー操作を実行
End Sub


#Region "Win32 API 関数の宣言及び変数の宣言"

''' <summary>
''' 指定のウィンドウをZオーダーのトップ位置に移動しアクティブにする(P99)
''' </summary>
''' <param name="hWnd">フォアグラウンドにするウィンドウのハンドルを指定</param>
''' <returns>正常終了の場合=0 以外  エラーの時= 0</returns>
<DllImport("USER32.DLL", CharSet:=CharSet.Auto)> _
Private Shared Function SetForegroundWindow( _
    ByVal hWnd As IntPtr) As IntPtr
End Function

''' <summary>
''' クラス名又はキャプションタイトルを与えてウィンドウのハンドルを取得
''' </summary>
''' <param name="hWnd1">
''' 検索する子ウィンドウの親ウィンドウのハンドルを指定、
''' NULLを指定すると、デスクトップウィンドウが親ウィンドウとして使われ
''' デスクトップの子ウィンドウが探されます
''' </param>
''' <param name="hWnd2">子ウィンドウのハンドルを指定</param>
''' <param name="lpsz1">クラス名又は、クラス名を指定するグローバルアトム</param>
''' <param name="lpsz2">ウィンドウのタイトルでNULLを指定するとクラス名のみで検索する</param>
''' <returns>関数が成功すると、指定したクラスとウィンドウ名を持つウィンドウのハンドルが返り
''' 　　　　 関数が失敗すると、NULL が返ります</returns>
<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
Private Shared Function FindWindowEx( _
    ByVal hWnd1 As IntPtr, _
    ByVal hWnd2 As IntPtr, _
    ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As IntPtr
End Function

<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
Private Shared Function MoveWindow( _
    ByVal hwnd As IntPtr, _
    ByVal x As Integer, _
    ByVal y As Integer, _
    ByVal nWidth As Integer, _
    ByVal nHeight As Integer, _
    ByVal bRepaint As Boolean) As Integer
End Function

#End Region
このページのトップへ移動します。 ８．Excel 2013 で印刷中のダイアログを非表示にして印刷(テスト版)

Private Sub Button28_Click(sender As Object, e As EventArgs) Handles Button28.Click
　　'テスト用の適当なファイル(印刷に時間がかかるような)を用意しておいて下さい。
　　'既存のファイルをオープンして、Excel を起動
　　Call ExcelOpen(System.IO.Path.GetFullPath("..\..\..\data\DBTest.xlsx"), "Sheet1")
　　'=============================================================================

　　'===================== 印刷中のダイアログを非表示に設定 ======================
　　'表示状態でも、非表示でも同じです。
　　xlApp.Visible = False
　　'確認のために、２秒間表示しておく
　　'WT.WaitTime(2000)

　　'バックグラウンドで、印刷中のダイアログが表示されたら閉じる
　　Me.BackgroundWorker2.RunWorkerAsync()
　　'印刷開始　100 部(プリンターの電源を切ってから試すと用紙が無駄になりません。)
　　xlSheet.PrintOutEx(, , 20)

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

'別途、ツールボックスから BackgroundWorker2 を貼り付けておいて下さい。
Private Sub BackgroundWorker2_DoWork(ByVal sender As Object, ByVal e As　_
　　　　　　System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker2.DoWork
　　Dim counter As Integer = 0
　　Dim wid As Integer = Screen.PrimaryScreen.Bounds.Width \ 2
　　Dim hei As Integer = Screen.PrimaryScreen.Bounds.Height \ 2
　　Do While counter < 50　　　'指定の回数繰り返したら終了
　　　　'画面の中心(ダイアログが表示される位置)にカーソルを移動する。
　　　　'(ダイアログがカーソルの裏になって再描画されなくなる)
　　　　Cursor.Position = New Point(wid, hei)

　　　　'印刷中のダイアログのハンドルを取得
　　　　Dim hwnd As IntPtr = FindWindowEx(IntPtr.Zero, IntPtr.Zero, vbNullString, "印刷中")
　　　　If hwnd <> IntPtr.Zero Then
　　　　　　MoveWindow(hwnd, 0, 0, 0, 0, False)
　　　　　　Exit Do
　　　　End If
　　　　WT.WaitTime(10)
　　　　counter += 1
　　Loop
End Sub
このページのトップへ移動します。 ９．Excel 2013 で行列を入れ替え及び型式を指定して保存

Private Sub Button29_Click(sender As Object, e As EventArgs) Handles Button29.Click
　　'既存のファイルをオープンして、Excel を起動
　　Call ExcelOpen(System.IO.Path.GetFullPath("..\..\..\data\dbtest.xlsx"), "Sheet1")
　　'=============================================================================

　　'================== 行列を入れ替え及び型式を指定して保存 =====================
　　Dim xlRange As Excel.Range
　　Dim xlSheet2 As Excel.Worksheet = DirectCast(xlSheets.Item(2), Excel.Worksheet)
　　xlRange = xlSheet.Range("A1")
　　xlRange.Activate()
　　Dim xlCurrentRegion As Excel.Range
　　xlCurrentRegion = xlRange.CurrentRegion
　　'セル A1 を含むデータ入力範囲をコピー
　　xlCurrentRegion.Copy()
　　MRComObject(xlCurrentRegion)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'コピーしたデータを 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　 '保存時の問合せのダイアログを非表示に設定

　　' xls 形式で名前をつけて保存(Excel 97〜2003 ブック形式)
　　xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.xls"), _
　　　　　　　　　　　　　　　　　　FileFormat:=Excel.XlFileFormat.xlExcel8)
　　' xlsx 形式で名前をつけて保存(Excel 2007〜ブック形式)
　　xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.xlsx"), _
　　　　　　　　　　　　　　　　　　FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbook)
　　' xlsm 形式で名前をつけて保存(Excel 2007〜マクロ有効ブック形式)
　　xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.xlsm"), _
　　　　　　　　　　　　FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbookMacroEnabled)
　　' csv 形式で名前をつけて保存(CSV (カンマ区切り) 形式)
　　xlBook.SaveAs(Filename:=IO.Path.GetFullPath(".\Test.csv"), _
　　　　　　　　　　　　　　　　　　　　FileFormat:=Excel.XlFileFormat.xlCSV)
　　MRComObject(xlRange)
　　MRComObject(xlRange2)
　　MRComObject(xlSheet2)
　　'確認のために、２秒間表示しておく
　　WT.WaitTime(2000)

　　'上記保存処理は、下記でファイル名を指定するだけで保存できます。

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xls"), False)　 'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 10．VB2013 から Excel のセルに関する操作、1行 Tips 集その１

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

　　'====================== セルに関する操作１行Tips集その１ =====================
　　'１．単一セルを参照する場合
　　'Worksheets("Sheet1").Range("A1").Value = 3.14159　'VBA の表記
　　'xlSheet.Range("A1").Value = 3.14159　 'VB6.0 用の表記(.NET 系では、使用しない事)

　　'上記のコードだけなら.NET系でも解放はされますが、色々参照している内に
　　'解放されない等トラブルを防ぐ意味でも下記のように一度、変数に受けて下さい。

　　Dim xlRange As Excel.Range = xlSheet.Range("A1")　　　'.NET 系の表記
　　xlRange.Value2 = 3.14159
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

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

　　'３．セル範囲を参照する場合その１
　　xlRange = xlSheet.Range("A1:C3")
　　xlRange.Select()
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

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

　　'４．離れたセル範囲を参照する場合その２
　　xlRange = xlSheet.Range("A1:C3,A6:C9,E1:H4")
　　xlRange.Select()
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

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

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

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

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

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

　　'10．Range.Cells プロパティを使ってセルを参照する
　　'Cells プロパティは、セルの指定方法が、Cells(行番号,列番号)のようになり、C5 等の通常の
　　'指定方法と行と列の順序が逆になりますので注意して下さい。

　　'シート 1 のセル範囲 A1:C5 のフォントスタイルを斜体に設定する VBA の使用例
　　'Worksheets("Sheet1").Activate()　　　　　　　　
　　'Range(Cells(1, 1), Cells(5, 3)).Font.Italic = True
　　'-------------------------------------------------------------------------------
　　'上記操作をVB2010用に書き換えると
　　'上記は、下記のようにした方が無難です。
　　Dim xlRange1 As Excel.Range = xlSheet.Range(R1ToA1(1, 1) & ":" & R1ToA1(5, 3))
　　'のようにして、Cellsプロパティを使わないようにして見て下さい。
　　'xlRange1.Font.Italic = True　のような使い方は、しない事
　　Dim xlFont As Excel.Font = xlRange1.Font
　　xlFont.Italic = True
　　MRComObject(xlFont)
　　MRComObject(xlRange1)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(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)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(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
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(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)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'14．セルの数式を取得する
　　xlRange = xlSheet.Range("E1")
　　Debug.Print(xlRange.Value.ToString)　　　　　　 '444
　　Debug.Print(xlRange.Formula.ToString)　　　　　 '=C1+D1
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(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)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 11．VB2013 から Excel のセルに関する操作、1行 Tips 集その２

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

　　'==================== セルに関する操作１行Tips集その２ =======================

　　'１．アクティブセル領域(空白行と空白列で囲まれたセル範囲)を取得
　　Dim adrs1, adrs2 As String
　　Dim msg As String = ""
　　Dim xlRange As Excel.Range = Nothing
　　'Worksheet.Range プロパティは、セルまたはセル範囲を表す Range オブジェクトを返します。
　　xlRange = xlSheet.Range("A1:D5") 'xlSheet.Range プロパティが返す、Range オブジェクトを取得
　　xlRange.Value = 123　　　　　　　'指定範囲内に仮データを入力
　　MRComObject(xlRange)　　　　　　 '従って使い終わったら直ぐ、デクリメントする事。
　　'ここで、違うセルを参照しているので(又は、変数名を別にするとか)
　　xlRange = xlSheet.Range("F1:K5")
　　xlRange.Value = "F1〜K5"
　　MRComObject(xlRange)

　　'セル "A1:D5" の範囲と"F1:K5" の範囲にデータが入っているものとして
　　xlRange = xlSheet.Range("B2")
　　Dim xlCurrentRegion As Excel.Range = Nothing
　　'Range.CurrentRegion プロパティは、アクティブセル領域(Range オブジェクト)を返します。
　　xlCurrentRegion = xlRange.CurrentRegion
　　adrs1 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　adrs2 = xlCurrentRegion.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlCurrentRegion)
　　MRComObject(xlRange)
　　msg = "No.１ セル [{0:}] のアクティブセル領域は、[{1:}] です。"
　　Me.Focus()
　　MessageBox.Show(Me, String.Format(msg, adrs1, adrs2))

　　xlRange = xlSheet.Range("H3")
　　xlCurrentRegion = xlRange.CurrentRegion
　　adrs1 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　adrs2 = xlCurrentRegion.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRange)
　　MRComObject(xlCurrentRegion)
　　MessageBox.Show(Me, String.Format(msg, adrs1, adrs2))
　　'-------------------------------------------------------------------------------
　　xlRange = xlSheet.Range("A1:L20")
　　xlRange.Value = Nothing
　　MRComObject(xlRange)
　　MessageBox.Show(Me, "一旦データを削除しました。")
　　'-------------------------------------------------------------------------------
　　'２．現在のセルに対して相対的な位置を指定・取得
　　xlRange = xlSheet.Range("A1:D5")
　　xlRange.Value = "A1〜D5"
　　Dim xlOffsetRange As Excel.Range = Nothing
　　'Range.Offset プロパティは、指定された範囲からのオフセットの範囲を表す Range オブジェクトを返す
　　xlOffsetRange = xlRange.Offset(RowOffset:=2, ColumnOffset:=6)
　　xlOffsetRange.Value = "Offset"
　　adrs1 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRange)
　　adrs2 = xlOffsetRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlOffsetRange)
　　msg = "No.２ セル[{0:}]の Offset(RowOffset:=2, ColumnOffset:=6) の領域は、[{1:}]です。"
　　MessageBox.Show(Me, String.Format(msg, adrs1, adrs2))
　　'Offset プロパティの使用例は、VB2010からExcelを操作するためのワンポイントテクニック集内でも
　　'幾つか使っていますので、最上部の[このページ内の検索ができます。]の所の検索ボックスに
　　'[Offset]をキーにして検索して見て下さい。
　　'-------------------------------------------------------------------------------
　　'３．対象となるセルが含まれる領域の終端のセルを取得
　　'End + 方向キー (↑、↓、←、→のいずれか) に相当します。
　　xlRange = xlSheet.Range("A1:E6")　　'A1:E6 の範囲に仮データを入力
　　xlRange.Value = "A1〜E6"
　　MRComObject(xlRange)

　　Dim xlRangeEnd As Excel.Range
　　xlRange = xlSheet.Range("D3")
　　'Range.End プロパティは,対象となるセルが含まれる領域の終端のセルを示すRangeオブジェクトを返す
　　xlRangeEnd = xlRange.End(Excel.XlDirection.xlToLeft)
　　adrs1 = xlRangeEnd.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRangeEnd)
　　MRComObject(xlRange)
　　msg = "No.３ セル範囲 A1:E6 に対するセル位置 D3 からの左端のセル位置は、"
　　MessageBox.Show(Me, msg & adrs1 & " です。")

　　xlRange = xlSheet.Range("D3")
　　xlRangeEnd = xlRange.End(Excel.XlDirection.xlToRight)
　　adrs1 = xlRangeEnd.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRangeEnd)
　　MRComObject(xlRange)
　　msg = "No.３ セル範囲 A1:E6 に対するセル位置 D3 からの右端のセル位置は、"
　　MessageBox.Show(Me, msg & adrs1 & " です。")

　　xlRange = xlSheet.Range("D3")
　　xlRangeEnd = xlRange.End(Excel.XlDirection.xlUp)
　　adrs1 = xlRangeEnd.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRangeEnd)
　　MRComObject(xlRange)
　　msg = "No.３ セル範囲 A1:E6 に対するセル位置 D3 からの上端のセル位置は、"
　　MessageBox.Show(Me, msg & adrs1 & " です。")

　　xlRange = xlSheet.Range("D3")
　　xlRangeEnd = xlRange.End(Excel.XlDirection.xlDown)
　　adrs1 = xlRangeEnd.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRangeEnd)
　　MRComObject(xlRange)
　　msg = "No.３ セル範囲 A1:E6 に対するセル位置 D3 からの下端のセル位置は、"
　　MessageBox.Show(Me, msg & adrs1 & " です。")

　　'-------------------------------------------------------------------------------
　　'４．指定されたワークシートで使われたセル範囲を取得
　　'Worksheet.UsedRange プロパティは、指定されたワークシートで使われた
　　'セル範囲(Range オブジェクト)を返します。
　　xlRange = xlSheet.UsedRange
　　adrs1 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRange)
　　msg = "No.４ 指定のシート内での使用済みセル範囲は、[ "
　　MessageBox.Show(Me, msg & adrs1 & " ]です。")
　　'-------------------------------------------------------------------------------
　　'５．指定のセル範囲から指定した列数、行数分のセル範囲にサイズ変更し変更されたセル範囲を取得
　　'Range.Rows プロパティは、指定されたセル範囲の行を表す Range オブジェクトを返します。
　　xlRange = xlSheet.Range("B3")
　　xlCurrentRegion = xlRange.CurrentRegion　'A1:E6
　　Dim xlResize As Excel.Range = Nothing
　　Dim rowsCount, columnsCount As Integer
　　Dim xlRows As Excel.Range = Nothing
　　Dim xlColumns As Excel.Range = Nothing
　　xlRows = xlCurrentRegion.Rows

　　rowsCount = xlRows.Count
　　'Range.Columns プロパティは、指定されたセル範囲の列を表す Range オブジェクトを返します。
　　xlColumns = xlCurrentRegion.Columns
　　columnsCount = xlColumns.Count
　　xlResize = xlCurrentRegion.Resize(rowsCount + 1, columnsCount + 1)
　　MRComObject(xlColumns)
　　MRComObject(xlRows)

　　'Excel をアクティブにする(エクセルにフォーカスを移す。)
　　AppActivate(xlApp.Caption)　　'必要ありませんが、見た目にわかりやすくする為に
　　xlResize.Select()　　　　　　 'サイズ変更した範囲を選択

　　adrs1 = xlResize.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlResize)
　　MRComObject(xlCurrentRegion)
　　MRComObject(xlRange)
　　msg = "No.５ セルB3に対するセル範囲[A1:E6]に対して、行・列 +1 したセル位置は、"
　　MessageBox.Show(Me, msg & adrs1 & " です。")
　　'-------------------------------------------------------------------------------
　　'-------------------------------------------------------------------------------
　　'６．セルを結合(マージ)する
　　Dim xlMergeRange As Excel.Range
　　xlMergeRange = xlSheet.Range("B10:D10")
　　'Range.Merge メソッドは、Range オブジェクト内のセルを結合して 1 つのセルにします。
　　xlMergeRange.Merge()
　　xlMergeRange.Value = "セル [B10:D10] を結合しました"
　　MRComObject(xlMergeRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)
　　'-------------------------------------------------------------------------------
　　'７．指定のセル位置の結合セル範囲を取得する
　　'指定のセルが結合セル範囲にある場合
　　'Range.MergeArea プロパティは、指定されたセルがある結合セル範囲を表すRangeオブジェクトを返す
　　xlMergeRange = xlSheet.Range("C10")
　　Dim xlMergeArea As Excel.Range
　　xlMergeArea = xlMergeRange.MergeArea
　　adrs1 = xlMergeArea.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MessageBox.Show(Me, "No.７ C10 の xlMergeArea セル位置は、" & adrs1 & " です。")
　　MRComObject(xlMergeArea)
　　MRComObject(xlMergeRange)

　　'指定のセルが結合セル範囲にない場合は、指定したセル位置が返る
　　xlMergeRange = xlSheet.Range("A10")
　　xlMergeArea = xlMergeRange.MergeArea
　　adrs1 = xlMergeArea.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MessageBox.Show(Me, "No.７ A10 の xlMergeArea セル位置は、" & adrs1 & " です。")
　　MRComObject(xlMergeArea)
　　MRComObject(xlMergeRange)

　　'-------------------------------------------------------------------------------
　　'８．指定のセル範囲に結合セルが含まれているかどうかを調べる
　　'Range.MergeCells プロパティは、セル範囲に結合セルが含まれている場合は、True を返します。
　　xlRange = xlSheet.Range("C10")
　　If CBool(xlRange.MergeCells) = True Then
　　　　MessageBox.Show(Me, "No.８ セル範囲(""C10"")には、結合セルが含まれます")
　　End If
　　MRComObject(xlRange)

　　xlRange = xlSheet.Range("A10")
　　If CBool(xlRange.MergeCells) = True Then
　　　　MessageBox.Show(Me, "No.８ セル範囲(""A10"")には、結合セルが含まれます")
　　Else
　　　　MessageBox.Show(Me, "No.８ セル範囲(""A10"")には、結合セルが含まれていません")
　　End If
　　MRComObject(xlRange)
　　'-------------------------------------------------------------------------------
　　'９．使用されたセル範囲内の最後のセルを取得
　　'Range.SpecialCells メソッドは、指定された条件を満たしているすべてのセルを返します。
　　Dim xlSpCells As Excel.Range
　　Dim xlRange2 As Excel.Range　　　'この場合、変数名を別にしないと解放されない。
　　xlSpCells = xlSheet.Cells
　　xlRange2 = xlSpCells.SpecialCells(Excel.XlCellType.xlCellTypeLastCell)
　　xlRange2.Activate()
　　adrs1 = xlRange2.Address(RowAbsolute:=False, ColumnAbsolute:=False)
　　MRComObject(xlRange2)
　　MRComObject(xlSpCells)
　　MessageBox.Show(Me, "No.９ 指定のシート内での使用済みの最後のセルは、[ " & adrs1 & " ]です。")
　　'-------------------------------------------------------------------------------
　　'11．指定のセル範囲内の空白のセルに、0 を代入する。
　　xlRange = xlSheet.Range("A1:D5")
　　xlRange.Activate()
　　xlRange.Value = ""　　 '空白のセルを作成する
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'セル "B2:C4" の範囲に仮のデータを表示
　　xlRange = xlSheet.Range("B2:C4")
　　xlRange.Value = "1234"
　　MRComObject(xlRange)

　　Dim xlBlanksRange As Excel.Range = Nothing
　　Dim nn As Integer = 0
　　Dim xlRange1 As Excel.Range　　　　'この場合、変数名を別にしないと解放されない。
　　xlRange1 = xlSheet.Range("A1:D5")
　　'※ SpecialCells メソッドは、指定した範囲に該当のセルが見つからない場合エラーとなります。
　　Try
　　　　'空白のセルを取得
　　　　xlBlanksRange = xlRange1.SpecialCells(Excel.XlCellType.xlCellTypeBlanks)
　　　　'見つかった、空白のセルに指定のデータを入力
　　　　xlBlanksRange.Value = "0"　'※ 数字(String)でないとエラーとなります。
　　　　'見つかった、空白のセル数を取得する
　　　　nn = xlBlanksRange.Count
　　　　MRComObject(xlRange1)
　　　　MRComObject(xlBlanksRange)
　　Catch ex As Exception
　　　　nn = 0
　　End Try
　　If nn = 0 Then
　　　　msg = "No.10 セル範囲[A1:D5]のは空白のセルが見つかりませんでした。"
　　　　MessageBox.Show(Me, msg)
　　Else
　　　　msg = "No.10 セル範囲[A1:D5]の空白のセル(" & nn.ToString & " 個)に 0 を代入しました。"
　　　　MessageBox.Show(Me, msg)
　　End If
　　'-------------------------------------------------------------------------------
　　'上記の他、SpecialCells メソッドの XlCellType 定数を指定する事で下記のようなセルを取得できます。
　　'xlCellTypeAllFormatConditions(表示形式が設定されているセル)
　　'xlCellTypeAllValidation(条件の設定が含まれているセル)
　　'xlCellTypeBlanks(空の文字列)
　　'xlCellTypeComments(コメントが含まれているセル)
　　'xlCellTypeConstants(定数が含まれているセル)
　　'xlCellTypeFormulas(数式が含まれているセル)
　　'xlCellTypeLastCell(使われたセル範囲内の最後のセル)
　　'xlCellTypeSameFormatConditions(同じ表示形式が設定されているセル)
　　'xlCellTypeSameValidation(同じ条件の設定が含まれているセル)
　　'xlCellTypeVisible(すべての可視セル)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 12．VB2013 から Excel のセルに関する操作、1行 Tips 集その３

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

　　'==================== セルに関する操作１行Tips集その３ =======================
　　'-------------------------------------------------------------------------------
　　'１．Range オブジェクトの色々な、Clear メソッドを試す
　　'・Range.Clear メソッド (オブジェクト全体をクリアします。)
　　'指定のシートの指定のセル範囲のデータと数式と書式設定を削除します。

　　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)

　　'上記の他、下記のようなメソッドも用意されています。(別の項で紹介予定)
　　'・Range.ClearComments メソッド(指定されたセル範囲からすべてのコメントを消去します。)
　　'・Range.ClearNotes メソッド(指定されたセル範囲内のすべてのセルからコメントを削除します。)
　　'・Range.ClearOutline メソッド(指定した範囲のアウトラインを消去します。)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'仮データの入力
　　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(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　xlRangeDat.Value = n
　　　　　　MRComObject(xlRangeDat)
　　　　Next
　　Next
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(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)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'３．セル(表全体)をコピー及び貼り付ける
　　Dim xlCurrentRegion As Excel.Range
　　xlCopyRange = xlSheet.Range("B2")
　　xlCurrentRegion = xlCopyRange.CurrentRegion
　　xlDestRange = xlSheet.Range("A15")
　　xlCurrentRegion.Copy(Destination:=xlDestRange)
　　MRComObject(xlCurrentRegion)
　　MRComObject(xlCopyRange)
　　MRComObject(xlDestRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'４．セル(セル範囲)を移動する
　　xlCopyRange = xlSheet.Range("C3")
　　xlDestRange = xlSheet.Range("H3")
　　xlCopyRange.Cut(Destination:=xlDestRange)
　　MRComObject(xlCopyRange)
　　MRComObject(xlDestRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'５．セル(表全体)をを移動する
　　xlCopyRange = xlSheet.Range("B2")
　　xlCurrentRegion = xlCopyRange.CurrentRegion
　　xlDestRange = xlSheet.Range("G11")
　　xlCurrentRegion.Cut(Destination:=xlDestRange)
　　MRComObject(xlCurrentRegion)
　　MRComObject(xlCopyRange)
　　MRComObject(xlDestRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'６．形式を選択して貼り付け
　　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(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　xlRangeDat.Value = n
　　　　　　MRComObject(xlRangeDat)
　　　　Next
　　Next

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

　　xlCopyRange = xlSheet.Range("B2")
　　xlCurrentRegion = xlCopyRange.CurrentRegion
　　xlCurrentRegion.Copy()
　　MRComObject(xlCurrentRegion)
　　MRComObject(xlCopyRange)

　　xlDestRange = xlSheet.Range("A10")
　　xlDestRange.PasteSpecial(Excel.XlPasteType.xlPasteValues)
　　MRComObject(xlDestRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(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)

　　'Excel(上にエラーを発生させるマクロ)
　　'Sub Macro1()
　　'　 myArray = Array(xlErrDiv0, xlErrNA, xlErrName, xlErrNull, _
　　'　　　 xlErrNum, xlErrRef, xlErrValue)
　　'　 For i = 1 To 7
　　'　　　 Worksheets("Sheet1").Cells(i, 1).Value = CVErr(myArray(i - 1))
　　'　 Next i
　　'End Sub
　　'MessageBox.Show("Excel 上にエラーを発生させておいて下さい。")

　　'確認のために、2秒間表示しておく
　　WT.WaitTime(2000)

　　Dim xlFunction As Excel.WorksheetFunction = xlApp.WorksheetFunction
　　For r As Integer = 1 To 10
　　　　For c As Integer = 1 To 3
　　　　　　xlRangeDat = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　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
　　　　　　MRComObject(xlRangeDat)
　　　　Next
　　Next
　　MRComObject(xlFunction)

　　'上記実行結果
　　'R1, C1 で　#DIV/0! (-2146826281)　のエラーが発生しました。
　　'R2, C1 で　#N/A 　 (-2146826246)　のエラーが発生しました。
　　'R3, C1 で　#NAME? (-2146826259)　のエラーが発生しました。
　　'R4, C1 で　#NULL! (-2146826288)　のエラーが発生しました。
　　'R5, C1 で　#NUM! 　 (-2146826252)　のエラーが発生しました。
　　'R6, C1 で　#REF! 　 (-2146826265)　のエラーが発生しました。
　　'R7, C1 で　#VALUE! (-2146826273)　のエラーが発生しました。
　　'確認のために、３秒間表示しておく
　　WT.WaitTime(1000)

　　'８．セルにコメントを表示及びコメント操作いろいろ
　　Call CommentsTest()

　　'確認のために、３秒間表示しておく
　　WT.WaitTime(1000)

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

Private Sub CommentsTest()
　　'８．セルにコメントを表示する
　　'=============================================================================
　　'セル A3 にコメントを新規作成(追加)します。
　　Dim xlRange As Excel.Range = Nothing
　　Dim xlComment As Excel.Comment
　　xlRange = xlSheet.Range("A3")
　　xlComment = xlRange.AddComment("セル A1 と A2 の合計です")
　　MRComObject(xlComment)
　　MRComObject(xlRange)

　　xlRange = xlSheet.Range("C8")
　　xlComment = xlRange.AddComment("ついでにもう1個作成しました。")
　　MRComObject(xlComment)
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'----------------------------------------------
　　'セル E3 にコメントを記入又は変更します。
　　xlRange = xlSheet.Range("E3")
　　xlRange.NoteText("変更予定")
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'----------------------------------------------
　　'最初のコメントを表示します。
　　Dim xlComments As Excel.Comments
　　xlComments = xlSheet.Comments
　　xlComment = xlComments.Item(1)
　　xlComment.Visible = True
　　MRComObject(xlComment)
　　MRComObject(xlComments)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'----------------------------------------------
　　'すべてのコメントを表示します。
　　xlComments = xlSheet.Comments
　　For Each xlComment In xlComments
　　　　xlComment.Visible = True
　　　　MRComObject(xlComment)
　　Next
　　MRComObject(xlComments)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'----------------------------------------------
　　'セル範囲を指定してコメントを削除
　　xlRange = xlSheet.Range("A1:A7")
　　xlRange.ClearComments()
　　MRComObject(xlRange)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'----------------------------------------------
　　'記入しているコメントを全て削除
　　xlComments = xlSheet.Comments
　　For Each xlComment In xlComments
　　　　xlComment.Delete()
　　　　MRComObject(xlComment)
　　Next
　　MRComObject(xlComments)
End Sub
このページのトップへ移動します。 13．VB2013 から Excel の表示処理速度を向上テスト

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

　　'========================== 表示処理速度を向上及び検索 =======================
　　'--------------------------------------------------------------------------
　　'仮データの入力
　　Dim xlRangeDat As Excel.Range = Nothing
　　Dim xlRange As Excel.Range = Nothing
　　Dim nRnd As New System.Random()
　　Dim sTime0 As DateTime
　　Dim eTime0 As DateTime
　　xlApp.ScreenUpdating = False
　　For i As Integer = 1 To 2
　　　　xlApp.ScreenUpdating = True
　　　　'画面の更新を停止して表示処理速度を向上させる
　　　　If i = 1 Then xlApp.ScreenUpdating = False
　　　　sTime0 = Now　　　　　 '処理時間計測開始
　　　　For c As Integer = 1 To 50
　　　　　　For r As Integer = 1 To 50
　　　　　　xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
　　　　　　'1 〜 100 までのランダムなデータを作成
　　　　　　xlRange.Value = Strings.ChrW(CInt(nRnd.Next(12354, 12400))).ToString & _
　　　　　　　　　　　　　　Strings.ChrW(CInt(nRnd.Next(12354, 12400))).ToString
　　　　　　MRComObject(xlRange)
　　　　　　Next r
　　　　Next c
　　　　'画面の更新をする(デフォルトに戻す)
　　　　xlApp.ScreenUpdating = True
　　　　eTime0 = Now　　　　　 '処理時間計測終了　　'　3.8 秒　→ 　7.3 秒　 現環境でも、2.71 秒 → 3.62 秒
　　　　MessageBox.Show(Me, eTime0.Subtract(sTime0).TotalSeconds & " 秒かかりました。")
　　Next i

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 14．VB2013から Excel のマクロを作成し実行する

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

　　'==================== VB2013からマクロを作成し実行する =======================
　　'Imports Microsoft.Vbe.Interop　 'を記入の事

　　'ファイル→オプション→セキュリティセンター→セキュリティセンターの設定→マクロの設定→
　　'VBA プロジェクトオブジェクトモデルへのアクセスを信頼する にチェックを入れておく事。

　　Dim xlVBE As Microsoft.Vbe.Interop.VBE
　　Dim xlProject As Microsoft.Vbe.Interop.VBProject
　　Dim xlComponents As Microsoft.Vbe.Interop.VBComponents = Nothing
　　Dim xlComponent As Microsoft.Vbe.Interop.VBComponent = Nothing
　　Dim xlCodeModule As Microsoft.Vbe.Interop.CodeModule

　　xlVBE = xlApp.VBE
　　xlProject = CType(xlBook.VBProject, Microsoft.Vbe.Interop.VBProject)
　　xlComponents = xlProject.VBComponents
　　xlComponent = xlComponents.Add(Microsoft.Vbe.Interop.vbext_ComponentType.vbext_ct_StdModule)
　　xlCodeModule = xlComponent.CodeModule

　　'標準モジュールに記入するマクロのコード
　　Dim MacroCord As String = ""
　　'CVErr 関数は、VB2013 には無く、VB2013 からは、使用できないようなので、マクロで実行
　　MacroCord = _
　　　　"Public Sub MacroTest()" & vbCrLf & _
　　　　"　 Dim myArray As Variant, i As Long" & vbCrLf & _
　　　　"　 myArray = Array(xlErrDiv0, xlErrNA, xlErrName, xlErrNull, xlErrNum,　_" & vbCrLf & _
　　　　"　　　　　　　　　　　　　　　　　　　　　　　　　xlErrRef, xlErrValue)" & vbCrLf & _
　　　　"　 For i = 1 To 7" & vbCrLf & _
　　　　"　　　Worksheets(""Sheet1"").Cells(i, 1).Value = CVErr(myArray(i - 1))" & vbCrLf & _
　　　　"　 Next i" & vbCrLf & _
　　　　"End Sub"
　　'マクロのコードを標準モジュールに書き込み
　　'変数の宣言を強制するにチェックが入っているとエラーとなるのでコメントに
　　'oCode.InsertLines(1, "Option Explicit")　
　　xlCodeModule.InsertLines(2, MacroCord)

　　'作成したマクロを実行する
　　xlApp.Run("MacroTest")
　　MessageBox.Show(Me, "VB2013 から MacroTest マクロを作成し、実行しました。")

　　'記入したマクロを削除する
　　xlComponents.Remove(xlComponent)
　　MessageBox.Show(Me, "VB2013 から作成した MacroTest マクロを削除しました。")

　　MRComObject(xlCodeModule)
　　MRComObject(xlComponent)
　　MRComObject(xlComponents)
　　MRComObject(xlProject)
　　MRComObject(xlVBE)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 15．Addressプロパティの使用例

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

　　'========================= Address プロパティの使用例 ========================
　　'-------------------------------------------------------------------------------
　　'１．セル(範囲)のアドレスを取得する
　　'　ここにきて、Address プロパティ を多用していて、Excel.exe が解放されなくなったので
　　'　Tips 集を見直すにあたり、調べて解った事を書いておきます。
　　'　Range.Address(プロパティ) をVBA のヘルプで見ると以下のようになっております。
　　'　コード記述時の言語で参照範囲を表す文字列型 (String) の値を返します。
　　' 式.Address(RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)
　　'　式　 Range オブジェクトを表す変数です。

　　' 使用例()
　　'mc = Worksheets("Sheet1").Cells(1, 1)
　　'MsgBox(mc.Address())　　　　　　　　　　　　　　　' $A$1
　　'MsgBox(mc.Address(RowAbsolute:=False))　　　　　　' $A1
　　'MsgBox(mc.Address(ReferenceStyle:=xlR1C1))　　　　' R1C1
　　'MsgBox(mc.Address(ReferenceStyle:=xlR1C1, RowAbsolute:=False, _
　　'　　　　ColumnAbsolute:=False, RelativeTo:=Worksheets(1).Cells(3, 3))) ' R[-2]C[-2]

　　'となっており、VB2013 用に書きかえるのもそう難しいことでもないかと思います。

　　'通常は、下記のように書きかえて使用すれば問題はないのですが...。
　　Dim xlRange As Excel.Range = Nothing
　　xlRange = xlSheet.Range("A1:D5")
　　Dim adrs1, adrs2, adrs3, adrs4 As String
　　adrs1 = xlRange.Address　　　　　　　　　　　　 ' $A$1:$D$5
　　adrs2 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)　　 ' A1:D5
　　adrs3 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False, _
　　　　　　　　　　　　　　ReferenceStyle:=Excel.XlReferenceStyle.xlA1)　 ' A1:D5

　　adrs4 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False, _
　　　　　　　　　　　　　　ReferenceStyle:=Excel.XlReferenceStyle.xlR1C1) ' RC:R[4]C[3]
　　MRComObject(xlRange)
　　MessageBox.Show(Me, String.Format( _
　　　　　　"adrs1={0:}　adrs2={1:}　adrs3={2:}　adrs4={3:}", adrs1, adrs2, adrs3, adrs4))

　　'個々で使用する場合は、問題無いのですが、以下で紹介するコードと同じプロシージャ内で使用すると
　　'Excel.exe が解放されず、プログラムを終了するまで、タスクマネージャーに残ったままになったり
　　'する場合があります。
　　'-------------------------------------------------------------------------------

　　'プロセスが解放され易くしたコード(逐次デクリメントを実施)
　　xlRange = xlSheet.Range("B3:F7")
　　adrs1 = xlRange.Address　　　　　　　　　　　　 ' $B$3:$F$7
　　MRComObject(xlRange)

　　xlRange = xlSheet.Range("B3:F7")
　　adrs2 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False)　　 ' B3:F7
　　MRComObject(xlRange)

　　xlRange = xlSheet.Range("B3:F7")
　　adrs3 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False, _
　　　　　　　　　　　　　　ReferenceStyle:=Excel.XlReferenceStyle.xlA1)　 ' B3*F7
　　MRComObject(xlRange)

　　xlRange = xlSheet.Range("B3:F7")
　　adrs4 = xlRange.Address(RowAbsolute:=False, ColumnAbsolute:=False, _
　　　　　　　　　　　　　　ReferenceStyle:=Excel.XlReferenceStyle.xlR1C1) ' R[2]C[1]:R[6]C[5]
　　MRComObject(xlRange)

　　MessageBox.Show(Me, String.Format( _
　　　　　　"adrs1={0:}　adrs2={1:}　adrs3={2:}　adrs4={3:}", adrs1, adrs2, adrs3, adrs4))

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 16．シートの指定範囲内を検索

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

　　'========================== シートの指定範囲内を検索 =======================
　　'仮データの入力
　　Dim xlRangeDat As Excel.Range = Nothing
　　Dim xlRange As Excel.Range = Nothing
　　Dim nRnd As New System.Random()
　　'画面の更新を停止して表示処理速度を向上させる
　　xlApp.ScreenUpdating = False
　　For c As Integer = 1 To 50
　　　　For r As Integer = 1 To 50
　　　　xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c))
　　　　'あ 〜 ば までのランダムなデータを作成
　　　　xlRange.Value = Strings.ChrW(CInt(nRnd.Next(12354, 12400))).ToString & _
　　　　　　　　　　　　Strings.ChrW(CInt(nRnd.Next(12354, 12400))).ToString
　　　　MRComObject(xlRange)
　　　　Next r
　　Next c
　　'画面の更新をする(デフォルトに戻す)
　　xlApp.ScreenUpdating = True

　　'[あい]を検索検索して見つかったセルをアクティブにする
　　Dim xlCells As Excel.Range = Nothing
　　Dim xlInterior As Excel.Interior = Nothing
　　'下記のように、Cells プロパティを引数無しで使用しても解放されますが、
　　'検索範囲が解っているので、xlRange = xlSheet.Range(R1ToA1(1, 1), R1ToA1(50, 50)) の
　　'ようにした方が解放されやすい。
　　'尚、 xlSheet.Cells は、 xlSheet.Range("1:1048576")　や xlSheet.Range("$1:$1048576") や
　　'xlSheet.Range("A1:XFD1048576") と指定するのも同じ事です。
　　'xlCells = xlSheet.Cells
　　xlCells = xlSheet.Range(R1ToA1(1, 1), R1ToA1(50, 50))
　　xlRange = xlCells.Find("あい")
　　If xlRange IsNot Nothing Then
　　　　xlRange.Activate()
　　　　xlInterior = xlRange.Interior
　　　　xlInterior.Color = Color.Red
　　　　xlApp.Goto(Reference:=xlRange, Scroll:=True)
　　　　MessageBox.Show(Me, "大吉！ 愛は、" & xlRange.Address & " に見つかりました。")
　　　　' Debug.Print(xlRange.Address)
　　　　MRComObject(xlInterior)
　　　　MRComObject(xlRange)
　　Else
　　　　MessageBox.Show(Me, "凶！ 愛は、見つかりませんでした。")
　　End If
　　MRComObject(xlCells)
　　'確認のために、１秒間表示しておく
　　WT.WaitTime(1000)

　　'=============================================================================
　　'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
　　Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)　'False の場合保存しないで終了
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 17．自作関数を使って罫線を描画

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

　　'========================== 自作関数を使って罫線を描画 =======================

　　'開始点、終了点、線種、線の太さ、位置(定数値)　を指定

　　'位置が 0 の場合は格子状に引く(省略可)
　　Call SetLine(2, 2, 8, 8, Excel.XlLineStyle.xlContinuous, Excel.XlBorderWeight.xlThin, 0)

　　'外枠を太線で描画
　　Call SetLine(2, 2, 8, 8, Excel.XlLineStyle.xlContinuous, Excel.XlBorderWeight.xlThick, 34)

　　'２重線で下の上側に引く
　　Call SetLine(8, 2, 8, 8, Excel.XlLineStyle.xlDouble, Excel.XlBorderWeight.xlThick, Excel.XlBordersIndex.xlEdgeTop)

　　WT.WaitTime(3000)

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

Private Function R1ToA1(ByVal r1 As Integer, ByVal c1 As Integer) As String
'R1C1形式のアドレスをA1形式に変換する関数
　　Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
　　Dim A1 As String = ""
　　If c1 < 1 Or c1 > 16384 Then
　　　　MessageBox.Show("指定が間違っています。")
　　　　A1 = "A1"
　　　　Return A1
　　End If
　　If c1 <= 26 Then
　　　　A1 = s.Chars(c1 - 1) & CStr(r1)
　　ElseIf c1 <= 702 Then
　　　　A1 = s.Chars(((c1 - 1) \ 26) - 1) & s.Chars(((c1 - 1) Mod 26)) & CStr(r1)
　　Else
　　　　A1 = s.Chars(((c1 - 703) \ 676)) & s.Chars((((c1 - 703) \ 26) Mod 26)) & _
　　　　　　　　　　　　　　　　　　　　　　s.Chars(((c1 - 1) Mod 26)) & CStr(r1)
　　End If
　　Return A1
End Function

'罫線を引く自作関数
'開始点、終了点、線種、線の太さ、位置(定数値)　を指定
'SetLine(2, 2, 8, 8,　は (B2:H8) になります。
'位置が 0 の場合は格子状に引く(省略可)
'位置が 34 の場合は外枠線を描く
'　5=左上から右下への罫線
'　6=左下から右上への罫線
'　7=セルの左辺の罫線
'　8=セルの上辺の罫線
'　9=セルの下辺の罫線
' 10=セルの右辺の罫線
' 11=内側の垂直線
' 12=内側の水平線
'http://hanatyan.sakura.ne.jp/dotnet/Excel06.htm#no3　を参照願います。
Private Sub SetLine(ByVal r1 As Integer, ByVal c1 As Integer, _
　　　　　　　　　　ByVal r2 As Integer, ByVal c2 As Integer, _
　　　　　　　　　　ByVal ls As Integer, ByVal lw As Integer, _
　　　　　　　　　　Optional ByVal lps As Integer = 0)
　　Dim xlRange As Excel.Range
　　Dim xlBorders As Excel.Borders
　　Dim xlBorder As Excel.Border
　　'線を引く範囲をA1形式で取得
　　xlRange = xlSheet.Range(R1ToA1(r1, c1), R1ToA1(r2, c2))
　　xlBorders = xlRange.Borders
　　If lps = 0 Then　　　　　　　　 '格子状に罫線を引く
　　　　xlBorders.LineStyle = ls
　　　　xlBorders.Weight = lw
　　ElseIf lps = 34 Then　　　　　　'外枠線を描く
　　　　For i As Int32 = 7 To 10
　　　　　　xlBorder = xlBorders(DirectCast(i, Excel.XlBordersIndex))　'罫線の表示位置を設定
　　　　　　xlBorder.LineStyle = ls　　　　 '罫線の線種を設定
　　　　　　xlBorder.Weight = lw　　　　　　'罫線の太さを設定
　　　　　　MRComObject(xlBorder)
　　　　Next i
　　Else　　　　　　　　　　　　　　'個別に罫線を引く
　　　　xlBorder = xlBorders(DirectCast(lps, Excel.XlBordersIndex))　　'罫線の表示位置を設定
　　　　xlBorder.LineStyle = ls　　　　 '罫線の線種を設定
　　　　xlBorder.Weight = lw　　　　　　'罫線の太さを設定
　　　　MRComObject(xlBorder)
　　End If
　　MRComObject(xlBorders)
　　MRComObject(xlRange)
End Sub
このページのトップへ移動します。 18．Excel の Speech.Speak での音声読み上げ

Private Sub Button38_Click(sender As Object, e As EventArgs) Handles Button38.Click
'ExcelのSpeech.Speak で読み上げ
　　Dim xlApp As New Microsoft.Office.Interop.Excel.Application
　　Dim xlSpeech As Microsoft.Office.Interop.Excel.Speech
　　xlSpeech = xlApp.Speech
　　xlSpeech.Speak("テキストボックスの　内容を読み上げます。")
　　'xlSpeech 及び xlApp を解放
　　xlApp.Quit()
　　System.Runtime.InteropServices.Marshal.ReleaseComObject(xlSpeech)
　　xlSpeech = Nothing
　　System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApp)
　　xlApp = Nothing

　　'=============================================================================
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()
End Sub
このページのトップへ移動します。 19．Excel の GetPhonetic メソッドを使ってのふりがなを取得

Private Sub Button39_Click(sender As Object, e As EventArgs) Handles Button39.Click
'Excel の GetPhonetic メソッドを使ってのふりがなを取得
　　Dim xlApp As New Excel.Application
　　Dim myName As String
　　Dim furigana As String
　　'文字列中の空白を除去(Microsoft.VisualBasic.Strings. を省略しております)
　　myName = StrConv("山田　花子", VbStrConv.Wide).Replace("　", "")
　　'ExcelのGetPhonetic関数を使ってふりがなを取得
　　furigana = xlApp.GetPhonetic(myName)
　　'取得したふりがなをひらがなに変換(お好みで)
　　TextBox1.Text = "山田　花子 ：" & StrConv(furigana, VbStrConv.Hiragana)
　　'xlApp を解放
　　xlApp.Quit()
　　System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApp)
　　xlApp = Nothing
'===================================================================================================
　　'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし)
　　WT.WaitTime(1000)
　　Call ProcessCheck()　'正常に動作する事が確認できたらこの行は、コメントにして下さい。
End Sub
このページのトップへ移動します。 20．


このページのトップへ移動します。 検索キーワード及びサンプルコードの別名(機能名)





このページのトップへ移動します。