 Excel・Word・VBA関係のメニュー |
| ２．Excel 操作ワンポイントテクニック集その１(09_Xls_02) (旧、SampleNo.460) |
| 下記プログラムコードに関する補足・注意事項 動作確認：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 参照設定：Microsoft Excel 15.0 Object Library / WaitTime.dll 参照設定方法参照 使用コン：Button1 〜 Button20 トロール： このサンプル等の内容を無断で転載、掲載、配布する事はお断りします。(私の修正・改訂・削除等が及ばなくなるので) 必要ならリンクをはるようにして下さい。(引用の場合は引用元のリンクを明記して下さい) |
 １．Excel の起動・終了に関する設定 |
| 長くなりますので、Excel の起動及び終了方法(09_Xls_01)と同じ部分は省略させて頂いています。 #Region "Excel の起動及び終了に関する設定" #Region "Private 変数の宣言" 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 frgClose As Boolean 'ユーザーが Excel を閉じようとしたかのフラグ Private WT As New WaitTime.Class1 #End Region #Region "Excel の起動時の処理関係" ---省略--- #End Region #Region "Excel の終了・保存処理関係" ---省略--- #End Region #Region "COM オブジェクトの解放(デクリメント処理)処理関係" ---省略--- #End Region Private Sub ProcessCheck() 'タスクマネージャーに、Excel.exe が残っていないか確認(テスト環境でのみ使用の事) '以前は、Loop しながら5秒間程繰り返し確認していたのだが、その間に解放される場合が 'ある事が判明したので、下記のように1回きりの確認でもデクリメント処理がきちんと '行われていたら解放される事が解ったので下記のように厳密に判定する事にしました。 If Process.GetProcessesByName("Excel").Length = 0 Then '先にフォームを閉じるとエラーが発生するので '必要により表示するようにして下さい。 MessageBox.Show(Me, "Excel.EXE は解放されました。") Exit Sub End If If Process.GetProcessesByName("Excel").Length >= 1 Then Dim ret As DialogResult ret = MessageBox.Show(Me, "まだ Excel.EXE が起動しています。強制終了しますか？", _ "確認", MessageBoxButtons.YesNo) If ret = Windows.Forms.DialogResult.Yes Then Dim localByName As Process() = Process.GetProcessesByName("Excel") Dim p As Process '起動中のExcelを取得 For Each p In localByName 'Windou の無い(表示していない)Excel があれば強制終了させる '画面に表示している Excel は、終了させないので必要なら手動で終了して下さい。 If System.String.Compare(p.MainWindowTitle, "", True) = 0 Then 'Excel.EXE のプロセスを削除 p.Kill() End If Next End If End If End Sub #End Region |
| ２．VB2013 から Excel へのデータの入力処理色々及び起動・終了処理例 |
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================== データの入力処理 ================================= '-------------------- マクロの記録を取った場合 ---------------------------- 'ActiveCell.FormulaR1C1 = "10" 'Range("A2").Select() 'ActiveCell.FormulaR1C1 = "20" 'Range("A3").Select() 'ActiveCell.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)" 'Range("A4").Select() '-------------------------------------------------------------------------- '１．単純なデータの入力と計算式の入力例 Dim xlRange As Excel.Range Dim strDat(2, 0) As Object xlRange = xlSheet.Range("A1:A3") 'データの入力セル範囲 strDat(0, 0) = "10" 'データの作成 strDat(1, 0) = "20" strDat(2, 0) = "=Sum(A1:A2)" '計算式 xlRange.Value = strDat 'セルへデータの入力 MRComObject(xlRange) '上記の他、下記のリンク先のサンプルを参考にして下さい。 'http://hanatyan.sakura.ne.jp/dotnet/Excel01.htm 'http://hanatyan.sakura.ne.jp/dotnet/Excel07.htm '確認のために、１秒間表示しておく WT.WaitTime(1000) '-------------------------------------------------------------------------- '２．２次元配列データの入力例 Dim xlRange1 As Excel.Range = Nothing Dim dat(20, 4) As String For r As Integer = 0 To 20 For c As Integer = 0 To 4 dat(r, c) = Str(r + 1) & "," & Str(c + 1) Next Next xlRange1 = xlSheet.Range("A1:D20") xlRange1.Value = dat '確認のために、１秒間表示しておく WT.WaitTime(1000) '入力したデータを削除 xlRange1.Value = "" MRComObject(xlRange1) '確認のために、１秒間表示しておく WT.WaitTime(1000) '-------------------------------------------------------------------------- '３．１次元配列データの入力(For Each...Next ステートメントを使った)例 Dim xlRange2 As Excel.Range = Nothing Dim xlElement As Excel.Range = Nothing Dim dat1(0) As String Dim n As Integer = -1 '２次元配列データを１次元配列に格納 For r As Integer = 1 To 20 For c As Integer = 1 To 4 n += 1 ReDim Preserve dat1(n) dat1(n) = Str(r) & "," & Str(c) Next Next xlRange2 = xlSheet.Range("A1:D20") Dim no As Integer = -1 'For Each...Next ステートメントを使って、１次元配列を２次元配列に表示 For Each xlElement In xlRange2 no += 1 xlElement.Value = dat1(no) '仮データを表示(順番にも注目） 'xlElement の参照先が変更されたのだからデクリメントする必要がある MRComObject(xlElement) Next MRComObject(xlRange2) '確認のために、１秒間表示しておく WT.WaitTime(1000) '４．１次元配列データを指定位置に入力 Dim xlRange3 As Excel.Range = Nothing xlRange3 = xlSheet.Range("G1:G20") no = -4 For Each xlElement In xlRange3 no += 4 xlElement.Value = dat1(no) '仮データを表示(順番にも注目） MRComObject(xlElement) 'ここも同様に直ちにデクリメントを Next MRComObject(xlRange3) '確認のために、１秒間表示しておく WT.WaitTime(1000) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() '正常に動作する事が確認できたらこの行は、コメントにして下さい。 End Sub |
| ３．VB2013 から Excel 上のデータをコピー・アンド・ペースト |
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================== Excel 上でコピー&ペースト ======================= '-------------------- マクロの記録を取った場合 ---------------------------- '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() '確認のために、１秒間表示しておく WT.WaitTime(1000) 'クリップボードの内容を指定のシートの指定のセルに貼り付ける 'xlSheet.Paste(xlSheet.Range("D1")) 'これは、間違った使用例です。(解放されなくなる) '確認のために、１秒間表示しておく 'WT.WaitTime(1000) '正しくは、 Dim xlPasteRange As Excel.Range = xlSheet.Range("D2") xlSheet.Paste(xlPasteRange) MRComObject(xlPasteRange) 'のように一度変数に受けて下さい。 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 |
| ４．VB2013 から Excel のセルの背景色を設定 |
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================== セルの背景色を設定 =============================== '-------------------- マクロの記録を取った場合 ---------------------------- 'ActiveCell.FormulaR1C1 = "あいうえお" 'Range("B2").Select() 'With Selection.Interior ' .Pattern = xlSolid ' .PatternColorIndex = xlAutomatic ' .Color = 65535 ' .TintAndShade = 0 ' .PatternTintAndShade = 0 'End With '-------------------------------------------------------------------------- 'Excel の定数を調べるには、>>2 の５．Excel の定数を調べるには の項をご覧下さい。 Dim xlRange As Excel.Range xlRange = xlSheet.Range("B2") xlRange.Value = "あいうえお" '仮データの表示 '確認のために、１秒間表示しておく WT.WaitTime(1000) Dim xlInterior As Excel.Interior xlInterior = xlRange.Interior With xlInterior '塗りつぶしのパターンと色を表す、xlPattern クラスの定数を設定 '検索キーワード [MSDN XlPattern 列挙型] http://tinyurl.com/7bwazhr .Pattern = Excel.XlPattern.xlPatternSolid '塗りつぶしのパターンと色を現在のカラーパレットのインデックス番号または定数で設定 'XlColorIndex クラスの xlColorIndexAutomatic または xlColorIndexNone です .PatternColorIndex = Excel.Constants.xlAutomatic '塗りつぶし等のカラーを設定下記のどの方法でも可 '.Color = 65535 '明るい黄色 '.Color = QBColor(14) '明るい黄色 .Color = RGB(255, 255, 0) '明るい黄色 '.Color = Color.Yellow '明るい黄色 ' カラーインデックス値の一覧表 ' http://hanatyan.sakura.ne.jp/samplepic/excel-1-1.gif '.ColorIndex = 6 '明るい黄色 '.ColorIndex = Excel.XlColorIndex.xlColorIndexNone 'セルの色(内部色)を標準にする '色を明るく、または暗くする単精度浮動小数点型 (-1 〜 + 1 の範囲の Single) の値を設定 .TintAndShade = 0 '網掛けパターンに濃淡を設定(TintAndShade と同様の設定値)塗りつぶしの場合は無視される '.PatternTintAndShade = 0 End With MRComObject(xlInterior) 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 |
| ５．VB2013 から Excel のセルにグラデーションを設定 |
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '======================== セルにグラデーションを設定 ========================= Dim xlRange As Excel.Range xlRange = xlSheet.Range("B2") xlRange.Value = "あいうえお" '確認のために、１秒間表示しておく WT.WaitTime(1000) Dim xlInterior As Excel.Interior xlInterior = xlRange.Interior Dim xlLinearGradient As Excel.LinearGradient Dim xlColorStops As Excel.ColorStops '塗りつぶしのパターンと色を表す、xlPattern クラスの定数を設定 '検索キーワード [MSDN XlPattern 列挙型] http://tinyurl.com/7bwazhr xlInterior.Pattern = Excel.XlPattern.xlPatternLinearGradient '型が不明の時は、下記のようにして調べる 'Debug.Print(TypeName(.Gradient)) ' LinearGradient xlLinearGradient = DirectCast(xlInterior.Gradient, Excel.LinearGradient) xlColorStops = xlLinearGradient.ColorStops 'グラデーションの塗りつぶしにおける直線の角度(0〜360の範囲) '左→右にグラデーション xlLinearGradient.Degree = 0 Dim xlColorStop1 As Excel.ColorStop Dim xlColorStop2 As Excel.ColorStop xlColorStops.Clear() xlColorStop1 = xlColorStops.Add(0) xlColorStop2 = xlColorStops.Add(1) xlColorStop1.Color = Color.Red '開始時の色 xlColorStop2.Color = Color.Yellow '終了時の色 'このようにここまで掘り下げて変数に受けてデクリメントしないと解放されない MRComObject(xlColorStop2) MRComObject(xlColorStop1) MRComObject(xlColorStops) MRComObject(xlLinearGradient) MRComObject(xlInterior) MRComObject(xlRange) '確認のために、１秒間表示しておく WT.WaitTime(2000) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| ６．VB2013 から Excel のセルの文字色を設定 |
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================== セルの文字色を設定 =============================== '-------------------- マクロの記録を取った場合 ---------------------------- '同じ色の場合 '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 Dim xlFont As Excel.Font xlRange = xlSheet.Range("B2") xlRange.Value = "あいうえお" xlFont = xlRange.Font xlFont.Color = Color.Red MRComObject(xlFont) MRComObject(xlRange) '確認のために、１秒間表示しておく WT.WaitTime(1000) '指定セル内の左から３文字目を赤色に設定 xlRange = xlSheet.Range("D2") xlRange.Value = "あいうえお" ' Debug.Print(TypeName(xlRange.Characters(Start:=3, Length:=1))) 'Characters 'Characters で s がついてはいるがデフォルトのプロパティがないので Dim xlCharacters As Excel.Characters xlCharacters = xlRange.Characters(Start:=3, Length:=1) xlFont = xlCharacters.Font xlFont.Color = Color.Red MRComObject(xlFont) MRComObject(xlCharacters) 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 |
| ７．VB2013 から Excel のセルのフォントの設定 |
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================== セルのフォントの設定 ============================= '-------------------- マクロの記録を取った場合 ---------------------------- '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 = "あいうえお" '確認のために、１秒間表示しておく WT.WaitTime(1000) Dim xlCharacters As Excel.Characters xlCharacters = xlRange.Characters(Start:=2, Length:=3) Dim xlFont As Excel.Font xlFont = xlCharacters.Font With xlFont .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(xlFont) MRComObject(xlCharacters) 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 |
| ８．VB2013 から Excel のセルの表示形式を設定 |
Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================= セルの表示形式を設定 ============================== '-------------------- マクロの記録を取った場合 ---------------------------- '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 xlRange = xlSheet.Range("A:A") xlRange.Select() xlRange.NumberFormatLocal = "@" MRComObject(xlRange) '確認のために、１秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("A2") xlRange.Value = "123456.78" MRComObject(xlRange) '確認のために、１秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("B:B") xlRange.Select() xlRange.NumberFormatLocal = "#,##0.0" MRComObject(xlRange) '確認のために、１秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("B2") xlRange.Value = "123456.78" MRComObject(xlRange) '確認のために、１秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("C:C") xlRange.Select() xlRange.NumberFormatLocal = "yyyy/mm/dd" MRComObject(xlRange) '確認のために、１秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("C2") xlRange.Value = "4/8" 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 |
| ９．VB2013 から Excel のセル上に画像を表示及び拡大・縮小 |
Private Sub Button8_Click(sender As Object, e As EventArgs) Handles Button8.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '==================== セル上に画像を表示及び拡大・縮小 ======================= '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/vbhlp/Excel12.htm '１．Pictureオブジェクトを使って表示 'xlSheet.Range("B2").Select() 'xlSheet.Pictures.Insert(MyPath).Select() '２．クリップボード経由での貼付け 'xlSheet.Range("H2").Select() 'xlSheet.Paste() '-------------------------------------------------------------------------- '１．Pictureオブジェクト(隠しオブジェクト)を使っての表示 Dim myPath As String = System.IO.Path.GetFullPath("..\..\..\data_pic\Test.gif") Dim xlRange As Excel.Range xlRange = xlSheet.Range("B2") Dim xlPictures As Excel.Pictures Dim xlPicture As Excel.Picture 'Debug.Print(TypeName(xlSheet.Pictures)) 'Pictures '面倒でも下記のように変数に受けないと解放されない xlPictures = DirectCast(xlSheet.Pictures, Excel.Pictures) xlPicture = xlPictures.Insert(myPath) 'Excel 2007では画像の挿入位置指定が下記のようにしないと指定できません。 With xlPicture .Top = CDbl(xlRange.Top) .Left = CDbl(xlRange.Left) End With MRComObject(xlPicture) MRComObject(xlPictures) MRComObject(xlRange) 'テストの為１秒間表示 WT.WaitTime(1000) ''２．Web 上の画像を指定して、Pictureオブジェクト(隠しオブジェクト)を使っての表示 myPath = "http://hanatyan.sakura.ne.jp/toppicture.gif" xlRange = xlSheet.Range("I2") xlPictures = DirectCast(xlSheet.Pictures, Excel.Pictures) xlPicture = xlPictures.Insert(myPath) With xlPicture .Top = CDbl(xlRange.Top) .Left = CDbl(xlRange.Left) End With MRComObject(xlPicture) MRComObject(xlPictures) MRComObject(xlRange) 'テストの為１秒間表示 WT.WaitTime(1000) '３．Web 上の画像を指定して、Shapes.Add メソッドを使っての表示 'Excel 2010 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると '図がリンクオブジェクトとして挿入される 'http://support.microsoft.com/kb/2396509/ja myPath = "http://hanatyan.sakura.ne.jp/toppicture.gif" Dim xlShapes As Excel.Shapes xlRange = xlSheet.Range("I15") xlShapes = xlSheet.Shapes Dim xlShape As Excel.Shape '画像のサイズが前もって解らない場合は、適当なサイズで仮取得(縦横共 100ピクセルで) xlShape = xlShapes.AddPicture(Filename:=myPath, _ LinkToFile:=MsoTriState.msoFalse, SaveWithDocument:=MsoTriState.msoTrue, _ Left:=CSng(xlRange.Left), Top:=CSng(xlRange.Top), Width:=CSng(100), Height:=CSng(100)) '図のサイズを元のサイズに戻します With xlShape .ScaleHeight(1.0!, MsoTriState.msoTrue) .ScaleWidth(1.0!, MsoTriState.msoTrue) End With MRComObject(xlShape) MRComObject(xlShapes) MRComObject(xlRange) 'テストの為１秒間表示 WT.WaitTime(1000) '４．クリップボード経由での貼付け '下記のリンクの画像をクリップボードにコピーしておいてから実行して下さい。 'http://hanatyan.sakura.ne.jp/toppicture.gif 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) 'テストの為１秒間表示 WT.WaitTime(1000) '５．拡大表示（1.25 = 拡大率(1.25倍)で指定） 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) MRComObject(xlShapes) 'テストの為１秒間表示 WT.WaitTime(1000) '６．縮小表示 xlShapes = xlSheet.Shapes 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) 'テストの為１秒間表示 WT.WaitTime(1000) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 10．VB2013 から Excel の指定位置に図形(オートシェイプ等)の描画及び削除 |
Private Sub Button9_Click(sender As Object, e As EventArgs) Handles Button9.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '=================== 図形(オートシェイプ等)の描画及び削除 ==================== '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=17 '-------------------------------------------------------------------------- Dim xlShapes As Excel.Shapes Dim xlShape As Excel.Shape xlShapes = xlSheet.Shapes '雲形吹き出しを描画 xlShape = xlShapes.AddShape(MsoAutoShapeType.msoShapeCloudCallout, 100, 30, 100, 40) MRComObject(xlShape) MRComObject(xlShapes) '1秒間表示しておく WT.WaitTime(1000) 'ブロック矢印を描画 xlShapes = xlSheet.Shapes xlShape = xlShapes.AddShape(MsoAutoShapeType.msoShapeRightArrow, 100, 100, 50, 50) '1秒間表示しておく WT.WaitTime(1000) 'オートシェイプ(ブロック矢印)の背景色と前景色を設定する Dim xlFillFormat As Excel.FillFormat xlFillFormat = xlShape.Fill With xlFillFormat .BackColor.RGB = RGB(255, 0, 255) .ForeColor.RGB = RGB(255, 215, 0) End With MRComObject(xlFillFormat) MRComObject(xlShape) MRComObject(xlShapes) '1秒間表示しておく WT.WaitTime(1000) '終端が三角形の矢印を描画 xlShapes = xlSheet.Shapes xlShape = xlShapes.AddLine(100, 200, 250, 200) Dim xlLineFormat As Excel.LineFormat xlLineFormat = xlShape.Line 'ここまで分解して取得しないと後で、はまる事になるので。 With xlLineFormat .EndArrowheadLength = MsoArrowheadLength.msoArrowheadLong .EndArrowheadStyle = MsoArrowheadStyle.msoArrowheadTriangle .EndArrowheadWidth = MsoArrowheadWidth.msoArrowheadWide .Weight = 5.0# End With MRComObject(xlLineFormat) MRComObject(xlShape) MRComObject(xlShapes) '1秒間表示しておく WT.WaitTime(1000) '図形を個別に削除する場合 xlShapes = xlSheet.Shapes xlShape = xlShapes.Item(1) xlShape.Delete() MRComObject(xlShape) MRComObject(xlShapes) '1秒間表示しておく WT.WaitTime(1000) '全てを削除する場合(Selection.Delete が使用できないので) xlShapes = xlSheet.Shapes For Each xlShape In xlShapes xlShape.Delete() MRComObject(xlShape) Next MRComObject(xlShapes) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 11．複数のCSVファイルを１つのBook内の複数のWorksheet上に読み込む |
Private Sub Button10_Click(sender As Object, e As EventArgs) Handles Button10.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '================ 複数のCSVファイルを１つのBookに読み込む ==================== '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=12 '-------------------------------------------------------------------------- '保存するファイルは、各自ご用意下さい。 Dim CSVFile(4) As String CSVFile(0) = System.IO.Path.GetFullPath("..\..\..\data\Chart3.csv") CSVFile(1) = System.IO.Path.GetFullPath("..\..\..\data\Chart4.csv") CSVFile(2) = System.IO.Path.GetFullPath("..\..\..\data\Chart5.csv") CSVFile(3) = System.IO.Path.GetFullPath("..\..\..\data\Chart6.csv") CSVFile(4) = System.IO.Path.GetFullPath("..\..\..\data\Chart7.csv") 'Excel 2007 〜 は、列数の Max が 1,048,576 行、16,384 列 '必要な場合は、変更して下さい。 Dim AllTextFormat(255) As Integer Dim i As Integer For i = 0 To 255 AllTextFormat(i) = 2 '全ての列を文字列型にする為の配列 Next i Dim xlQueryTables As Excel.QueryTables = Nothing Dim xlQueryTable As Excel.QueryTable = Nothing Dim xlRange As Excel.Range = Nothing Dim xlSheet1 As Excel.Worksheet = Nothing For i = 0 To CSVFile.GetUpperBound(0) 'ファイル数分シートがあるかを調査 If xlSheets.Count >= i + 1 Then xlSheet1 = DirectCast(xlSheets.Item(i + 1), Excel.Worksheet) Else '無ければシートを追加 xlSheet1 = DirectCast(xlSheets.Add, Excel.Worksheet) End If xlRange = xlSheet1.Range("A1") xlQueryTables = xlSheet1.QueryTables xlQueryTable = xlQueryTables.Add(Connection:="TEXT;" & CSVFile(i), Destination:=xlRange) With xlQueryTable .TextFilePlatform = 932 'Excel 2000 の場合は、xlWindows で .TextFileCommaDelimiter = True '全ての列をテキスト型に設定(無難なので) .TextFileColumnDataTypes = AllTextFormat .Refresh() End With MRComObject(xlQueryTable) MRComObject(xlQueryTables) MRComObject(xlRange) MRComObject(xlSheet1) '確認のために、１秒間表示しておく WT.WaitTime(1000) Next i 'ファイルを保存するようにしましたので、確認して見て下さい。 '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), True) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 12．VB2013 から Excel の Worksheet の列幅を取得・列幅を設定 |
Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================= 列幅を取得・列幅を設定 ============================ '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=6 '-------------------------------------------------------------------------- 'Excel 操作部分(列幅を取得・列幅を設定・セルの文字列長に合せて列幅を設定する） '列幅を取得(列幅の単位は、標準スタイルの 1 文字分の幅に相当します。 Dim xlRange As Excel.Range 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 の参照先を変更するのでその前にデクリメントを 'しておかないと Range("A:X") の参照先がなくなり破棄できなくなる MRComObject(xlRange) '仮データを入力 xlRange = xlSheet.Range("B1:D1") xlRange.Value = "あいうえおかきくけこ" 'データの文字列長に合せて列幅を自動調整 Dim xlColumns As Excel.Range xlColumns = xlRange.Columns 'この場合は、引数を指定しないので、これでOK xlColumns.AutoFit() MRComObject(xlColumns) 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 |
| 13．VB2013 から Excel の Worksheet の行の高さを設定・行の高さを自動調整 |
Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click 'テスト用の適当なファイルを用意しておいて下さい。 '既存のファイルをオープンして、Excel を起動 Call ExcelOpen(System.IO.Path.GetFullPath("..\..\..\data\DBTest.xlsx"), "Sheet1") '============================================================================= '==================== 行の高さを設定・行の高さを自動調整 ===================== '確認のために、１秒間表示しておく WT.WaitTime(1000) Dim xlRange As Excel.Range xlRange = xlSheet.Range("3:10") '行の高さを25 ポイント(25/72 インチ)に設定 xlRange.RowHeight = 25 '確認のために、１秒間表示しておく WT.WaitTime(1000) '行の高さを文字の高さに合せて自動調整 Dim xlRows As Excel.Range xlRows = xlRange.Rows xlRows.AutoFit() MRComObject(xlRows) MRComObject(xlRange) '確認のために、２秒間表示しておく WT.WaitTime(2000) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(2000) Call ProcessCheck() End Sub |
| 14．VB2010 から Excel の Worksheet の使用済みのセル範囲を取得 |
Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '======================== 使用済みのセル範囲を取得 =========================== '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=8 '-------------------------------------------------------------------------- Dim xlRange As Excel.Range Dim Dat(2, 5) As Object Dat(0, 0) = 4 : Dat(0, 1) = 4 : Dat(0, 2) = 5 : Dat(0, 3) = 8 : Dat(0, 4) = 9 : Dat(0, 5) = "" Dat(1, 0) = 3 : Dat(1, 1) = 3 : Dat(1, 2) = 5 : Dat(1, 3) = 9 : Dat(1, 4) = "" : Dat(1, 5) = "" Dat(2, 0) = 1 : Dat(2, 1) = 7 : Dat(2, 2) = 1 : Dat(2, 3) = 6 : Dat(2, 4) = 4 : Dat(2, 5) = 3 xlRange = xlSheet.Range("A1:F3") 'データの入力セル範囲 xlRange.Value = Dat 'セルへデータの入力 '1秒間表示しておく MRComObject(xlRange) WT.WaitTime(1000) 'データの入力範囲の取得 '指定のセル位置を含む空白行と空白列に囲まれた最小のセル範囲を取得 'Activateなセル("A1")があるActivateセル領域を選択します。 xlRange = xlSheet.Range("A1") xlRange.Activate() Dim xlCurrentRegion As Excel.Range xlCurrentRegion = xlRange.CurrentRegion xlCurrentRegion.Select() '---------------------------------------------- 'Address プロパティでその範囲を A1 形式で取得。 Dim xlRange1 As Excel.Range xlRange1 = xlSheet.Range("A5") '又は、xlRange1 = xlSheet.Range(R1ToA1(5, 1)) xlRange1.Value = "セル A1 があるActivateセル領域は " & _ xlCurrentRegion.Address(False, False, Excel.XlReferenceStyle.xlA1) & " の範囲です。" MRComObject(xlRange1) MRComObject(xlRange) MRComObject(xlCurrentRegion) '1秒間表示しておく WT.WaitTime(1000) '---------------------------------------------- 'xlSheet 上の使用済みのセル範囲を取得 Dim xlCells As Excel.Range xlCells = xlSheet.Cells xlRange1 = DirectCast(xlCells(6, 1), Excel.Range) Dim xlUsedRange As Excel.Range xlUsedRange = xlSheet.UsedRange xlRange1.Value = "使用済みセル領域は " & _ xlUsedRange.Address(False, False, Excel.XlReferenceStyle.xlA1) & " です。" MRComObject(xlUsedRange) MRComObject(xlCells) MRComObject(xlRange1) '1秒間表示しておく WT.WaitTime(1000) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 15．R1C1形式をA1形式に変換する関数及びその使用例 |
Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click 'R1C1形式をA1形式に変換する関数の使用例 Dim R1 As Integer = 10 '行番 Dim C1 As Integer = 1378 '列番 'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。 '結果 (10,1378) → ("AZZ10") MessageBox.Show(R1.ToString() & " , " & C1.ToString() & " = " & R1ToA1(R1, C1) & " です。") 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 |
| 16．A1形式をR1C1形式に変換する関数及びその使用例 |
Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click '=================== A1形式をR1C1形式に変換する関数 ========================== Dim A1 As String = "AZZ200" '行番 'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。 Dim r1a1() As Integer = A1ToR1(A1) '結果 AZZ200 = 200,1378 です。 MessageBox.Show(A1 & " = " & r1a1(0).ToString() & "," & r1a1(1).ToString() & " です。") '============================================================================= Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 xlApp.Visible = False '-------------------------------------------------------------------------- 'Excel の Address 関数を使った方が簡単かも Dim xlRange As Excel.Range xlRange = xlSheet.Range("AZZ200") Dim Col() As String = xlRange.Address(True, True, _ Excel.XlReferenceStyle.xlR1C1).Replace("R", "").Split("C"c) MessageBox.Show("AZZ200 = " & Col(0) & " , " & Col(1) & " です。") MRComObject(xlRange) Dim r1c1() As Integer = A1ToR1C1("A2:AZZ200") '結果 [A2:AZZ200] = 2,1,200,1378 です。 MessageBox.Show("[A2:AZZ200] = " & r1c1(0).ToString() & "," & r1c1(1).ToString() & _ " , " & r1c1(2).ToString() & "," & r1c1(3).ToString() & " です。") '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub Private Function A1ToR1(ByVal A1 As String) As Integer() 'A1形式をR1C1形式に変換する関数(計算式で求める方法) Dim R1A1(1) As Integer R1A1(0) = 0 R1A1(1) = 0 A1.ToUpper() Dim nLen As Integer = A1.Length Dim strColum As String = "" Dim strRow As String = "" For i As Integer = 0 To nLen - 1 Dim wrk As String = A1.Substring(i, 1) If AscW(wrk) >= 64 And AscW(wrk) <= 90 Then strColum &= wrk ElseIf AscW(wrk) >= 48 And AscW(wrk) <= 57 Then strRow &= wrk Else MessageBox.Show("指定が間違っています。") Return R1A1 End If Next Debug.Print(strColum & " : " & strRow) A1 = strColum Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Dim B1 As String = A1.ToUpper Dim A2 As String = "" Dim n As Integer = B1.Length If n > 3 Then n = 3 For i As Integer = 0 To n - 1 If s.IndexOf(B1.Substring(i, 1)) >= 0 Then A2 &= B1.Substring(i, 1) End If Next n = A2.Length Dim C1 As Integer = 0 If n = 1 Then C1 = s.IndexOf(A2) + 1 ElseIf n = 2 Then C1 = (s.IndexOf(A2.Substring(0, 1)) + 1) * 26 C1 += s.IndexOf(A2.Substring(1, 1)) + 1 Else C1 = ((s.IndexOf(A2.Substring(0, 1)) + 1) * 676) C1 += (s.IndexOf(A2.Substring(1, 1)) + 1) * 26 C1 += s.IndexOf(A2.Substring(2, 1)) + 1 End If R1A1(0) = CInt(strRow) R1A1(1) = C1 Return R1A1 End Function 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 xlRange = xlSheet.Range(adr1) Dim Col() As String = xlRange.Address(True, True, _ Excel.XlReferenceStyle.xlR1C1).Replace("R", "").Split("C"c) MRComObject(xlRange) 'ここも参照先が変わるので 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 |
| 17．VB2013 から Excel の Worksheet 上で行・列・セルの挿入及び削除 |
Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '===================== 行・列・セルの挿入及び削除 ============================ '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=11 '-------------------------------------------------------------------------- '何も記入していないと解らないので仮データを記入(R1ToA1 関数の使用例もかねて) Dim xlRange As Excel.Range = Nothing For c As Integer = 1 To 10 For r As Integer = 1 To 20 xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c)) xlRange.Value = r + c MRComObject(xlRange) 'ここも直ちにデクリメントの事 Next r Next c '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '--------------------------------------------------------- '4行目と5行の間に1行挿入します。 Dim xlRows As Excel.Range Dim xlRow As Excel.Range xlRows = xlSheet.Rows xlRow = DirectCast(xlRows.Item(5), Excel.Range) xlRow.Insert() '動作確認の為に1秒間表示しておく WT.WaitTime(1000) xlRow.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftDown) '上記と同じ MRComObject(xlRow) MRComObject(xlRows) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '4行目と5行の間に1行挿入します。 '下記の場合は、"A1" のように指定するとセルの挿入になる xlRange = xlSheet.Range("5:5") xlRange.Insert() MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '下記の場合は、"B5" として行の挿入になる xlRange = xlSheet.Range("B5") Dim xlEntireRow As Excel.Range xlEntireRow = xlRange.EntireRow xlEntireRow.Insert() MRComObject(xlEntireRow) MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '------------------ 以上 ４行挿入 --------------------- '4列目と5列の間に1列挿入します。 Dim xlColumns As Excel.Range Dim xlColumn As Excel.Range xlColumns = xlSheet.Columns xlColumn = DirectCast(xlColumns.Item(5), Excel.Range) xlColumn.Insert() MRComObject(xlColumn) MRComObject(xlColumns) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("E:E") xlRange.Insert() '動作確認の為に1秒間表示しておく WT.WaitTime(1000) Dim xlEntireColumn As Excel.Range xlEntireColumn = xlRange.EntireColumn xlEntireColumn.Insert() MRComObject(xlEntireColumn) MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '------------------ 以上 ３列挿入 --------------------- 'C列の5行目にセルを挿入します。 xlRange = xlSheet.Range("C5") xlRange.Insert() MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) 'C列の3行目のセルを右に挿入します。 xlRange = xlSheet.Range("C3") xlRange.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftToRight) MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '5行目を削除します。 xlRows = xlSheet.Rows xlRow = DirectCast(xlRows.Item(5), Excel.Range) xlRow.Delete() MRComObject(xlRow) MRComObject(xlRows) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("5:5") xlRange.Delete() MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("A5") xlEntireRow = xlRange.EntireRow xlEntireRow.Delete() MRComObject(xlRange) MRComObject(xlEntireRow) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) 'C列の3行目のセルを左に削除します。 xlRange = xlSheet.Range("C3") xlRange.Delete(Shift:=Excel.XlDeleteShiftDirection.xlShiftToLeft) MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '5列目を削除します。 xlColumns = xlSheet.Columns xlColumn = DirectCast(xlColumns.Item(5), Excel.Range) xlColumn.Delete() MRComObject(xlColumn) MRComObject(xlColumns) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("A5") xlEntireRow = xlRange.EntireRow xlEntireRow.Delete() MRComObject(xlRange) MRComObject(xlEntireRow) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("E:E") xlRange.Delete() MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) xlRange = xlSheet.Range("E:E") '再度指定しないと削除済みなのでエラーとなります。 xlEntireColumn = xlRange.EntireColumn xlEntireColumn.Delete() MRComObject(xlRange) MRComObject(xlEntireColumn) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) 'C列の5行目のセルを削除します。 xlRange = xlSheet.Range("C5") xlRange.Delete() MRComObject(xlRange) '動作確認の為に1秒間表示しておく WT.WaitTime(1000) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 18．指定のセルが指定の範囲内(共有セル範囲内)にあるか、どうかを調査 |
Private Sub Button17_Click(sender As Object, e As EventArgs) Handles Button17.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '==================== 指定のセルが指定の範囲内にあるか ======================= '---------------- 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 xlTargetRange As Excel.Range xlRange = xlSheet.Range("A1:H20") '指定のセル範囲内 xlTargetRange = xlSheet.Range("G15") '指定のセル位置 'Application.Intersect メソッド : 複数のセル範囲の共有セル範囲を '表す Range オブジェクトを返します。 '共有セル範囲を調べているので、xlTRange と xlRange は入れ替えても同じです。 Dim xlIntersect As Excel.Range xlIntersect = xlApp.Intersect(xlTargetRange, xlRange) If Not xlIntersect Is Nothing Then 'Range.Address プロパティを使って、A1 形式のアドレスを取得 MessageBox.Show(Me, " セル[" & xlTargetRange.Address(False, False) & "]は、セル[" & _ xlRange.Address(False, False) & "]の範囲内にあります。") Else MessageBox.Show(Me, " セル[" & xlTargetRange.Address(False, False) & "]は、セル[" & _ xlRange.Address(False, False) & "]の範囲内には、ありません。") End If MRComObject(xlTargetRange) MRComObject(xlIntersect) MRComObject(xlRange) xlTargetRange = xlSheet.Range("A1:G21") xlRange = xlSheet.Range("A1:H20") xlIntersect = xlApp.Intersect(xlTargetRange, xlRange) If Not xlIntersect Is Nothing Then 'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。 MessageBox.Show(Me, " セル[" & xlTargetRange.Address(False, False) & "]は、セル[" & _ xlRange.Address(False, False) & "]の範囲内にあります。") Else MessageBox.Show(Me, " セル[" & xlTargetRange.Address(False, False) & "]は、セル[" & _ xlRange.Address(False, False) & "]の範囲内には、ありません。") End If MRComObject(xlTargetRange) MRComObject(xlIntersect) MRComObject(xlRange) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 19．Excel のシート数・シート名の取得及びシートの追加・削除 |
Private Sub Button18_Click(sender As Object, e As EventArgs) Handles Button18.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '============== シート数・シート名の取得及びシートの追加・削除 =============== '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=7 '-------------------------------------------------------------------------- 'シート(Worksheet)数の取得 Dim sheetCount As Integer sheetCount = xlSheets.Count 'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。 MessageBox.Show(Me, "現在のシート(Worksheet)数 = " & sheetCount & " です。") '新規にシートを追加 Dim xlSheet2 As Excel.Worksheet xlSheet2 = DirectCast(xlSheets.Add, Excel.Worksheet) MRComObject(xlSheet2) sheetCount = xlSheets.Count MessageBox.Show(Me, "シートを１個追加したので、Worksheet 数 = " & sheetCount & " です。") '追加したシートの名前を取得 Dim xlSheet1 As Excel.Worksheet xlSheet1 = DirectCast(xlSheets.Item(sheetCount), Excel.Worksheet) MessageBox.Show(Me, "追加したシート名 = " & xlSheet1.Name & " です。") '追加したシートの名前を変更 xlSheet1.Name = "Test1" '変更したシート名を取得(確認） MessageBox.Show(Me, "シート名を " & xlSheet1.Name & " に変更しました。") '追加したシートを削除 xlSheet1.Delete() sheetCount = xlSheets.Count MRComObject(xlSheet1) MessageBox.Show(Me, "追加したシートを削除したので、Worksheet 数 = " & sheetCount & " です。") 'シート名の取得 Dim xlElement As Excel.Worksheet = Nothing For Each xlElement In xlSheets Debug.Print(xlElement.Name) MRComObject(xlElement) Next '----------------------------------------------------------------------- '新規にBook を開いた時に表示したいシート数を設定する場合 'Excelのツール→オプション→全般→新しいブックのシート数 の設定と同じ 'xlApp.SheetsInNewWorkbook = 1 'Book をオープンする前に書いて下さい。 '----------------------------------------------------------------------- '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 20．VB2013 から Excel のワークシート関数を使用する |
Private Sub Button19_Click(sender As Object, e As EventArgs) Handles Button19.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '===================== VB2010 からExcel の関数を使用する ===================== '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=8 '-------------------------------------------------------------------------- '仮データの入力 Dim xlRange As Excel.Range = Nothing Dim retValue As Double = 0 For c As Integer = 1 To 10 For r As Integer = 1 To 10 xlRange = xlSheet.Range(R1ToA1(r, c), R1ToA1(r, c)) retValue += 1 xlRange.Value = retValue MRComObject(xlRange) 'ここも直ちにデクリメントして下さい。 Next r Next c xlRange = xlSheet.Range("B3:D10") 'Visual Basic から Excel のワークシート関数を使用する Dim xlFunction As Excel.WorksheetFunction = xlApp.WorksheetFunction '指定セル範囲内のデータの個数を取得 retValue = xlFunction.Count(xlRange) 'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。 MessageBox.Show(Me, "[A1:j10]の範囲内のデータの個数 = " & retValue & " です。") '指定セル範囲内のデータの最小値を取得 retValue = xlFunction.Min(xlRange) MessageBox.Show(Me, "[A1:j10]の範囲内のデータの最小値 = " & retValue & " です。") '指定セル範囲内のデータの最大値を取得 retValue = xlFunction.Max(xlRange) MessageBox.Show(Me, "[A1:j10]の範囲内のデータの最大値 = " & retValue & " です。") '指定セル範囲内のデータの合計を取得 retValue = xlFunction.Sum(xlRange) MessageBox.Show(Me, "[A1:j10]の範囲内のデータの合計 = " & retValue & " です。") '指定セル範囲内のデータの平均値を取得 retValue = xlFunction.Average(xlRange) MessageBox.Show(Me, "[A1:j10]の範囲内のデータの平均値 = " & retValue & " です。") MRComObject(xlRange) MRComObject(xlFunction) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 21．VB2010 から Excel の表の縦横の合計を求める |
Private Sub Button20_Click(sender As Object, e As EventArgs) Handles Button20.Click Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 '============================================================================= '========================== 表の縦横の合計を求める =========================== '-------------------- 下記のVB6.0用コードを移植 --------------------------- ' http://hanatyan.sakura.ne.jp/patio/read.cgi?mode=view2&f=128&no=10 '-------------------------------------------------------------------------- '仮データの入力 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 xlRange.Value = retValue MRComObject(xlRange) Next r Next c '確認のために、１秒間表示しておく WT.WaitTime(1000) 'Activateなセル("C1")があるActivateセル領域を選択します。 '必ず、表内のセルを指定して下さい。 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 列 '行の合計を求めるセル位置を設定 1,5+1 → F1 xlRange = xlSheet.Range(R1ToA1(r1, C2 + 1)) '行の合計を求める xlRange.FormulaR1C1 = "=SUM(RC[-" & CInt(C2 - C1 + 1) & "]:RC[-1])" Dim xlRange1 As Excel.Range '計算式をコピーする範囲を求める(必ず、別の Range で受けて下さい。) xlRange1 = xlSheet.Range(R1ToA1(r1, C2 + 1) & ":" & R1ToA1(r2, C2 + 1)) '計算式を下方向にコピー(xlRange と xlRange1 の使い分けに注目) xlRange.AutoFill(Destination:=xlRange1, Type:=Excel.XlAutoFillType.xlFillDefault) MRComObject(xlRange1) MRComObject(xlRange) '列の合計を求めるセル位置を設定 xlRange = xlSheet.Range(R1ToA1(r2 + 1, C1)) '列の合計を求める xlRange.Formula = "=SUM(R[-" & CInt(r2 - r1 + 1) & "]C:R[-1]C)" '計算式をコピーする範囲を求める(必ず、別の Range で受けて下さい。) xlRange1 = xlSheet.Range(R1ToA1(r2 + 1, C1) & ":" & R1ToA1(r2 + 1, C2 + 1)) '計算式を下方向にコピー(xlRange と xlRange1 の使い分けに注目) xlRange.AutoFill(Destination:=xlRange1, Type:=Excel.XlAutoFillType.xlFillDefault) MRComObject(xlRange) MRComObject(xlRange1) '確認のために、２秒間表示しておく WT.WaitTime(2000) '============================================================================= 'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャーに残っていないか調査(実使用時は必要なし) WT.WaitTime(1000) Call ProcessCheck() End Sub |
| 22． |
| 23． |
| 24． |
| 25． |
| 検索キーワード及びサンプルコードの別名(機能名) |
|