www.smiyasaka.com は、2022 年 11月から Oracle LInux 8.X にOSを変更しました。 |
● Excel 2007 ~ 2019 対応マクロの勉強室 ● |
アクセス数 昨日 2 今日 1 累計 54,393 |
私が苦労したことが、何かの参考になればと思い公開しています。 |
目 次 |
||
※
[ 総てを表示する ] ※
2.
[ 写真の貼付けをする。 ]
6.
[ シートコピーが、エラーになる時の対処方法 ]
7.
[ 任意のセルを保護する方法 ]
8.
[ インプットボックスで、セル参照結果を取得する方法 ]
10.
[ アドイン メニューコマンドが消えずに残った時の対処方法 ]
11.
[ 動的配列変数という変数を知っていますか??? ]
12.
[ 出勤台帳・日報等作成時、マクロでの年月日の扱い方 ]
13.
[ 関数を使い処理のスピードアップをする ]
|
||
1. EXCEL 2019 ユーザーフォームを使用するマクロへの特別の配慮や工夫 |
||
下記写真は、Excel2010(上)と Excel2019(下)で同時に3個のブックをマクロで順番に開き整列表示
させた時の画面表示です。 |
||
Excel2010 の場合 Excel2019 の場合 |
||
特 別 の 配 慮 や 工 夫 ( 対 策 方 法 ) | ||
1. PC のディスプレイを追加して、マルチディスプレイの環境下で、使用する。 | ||
2. 私の様に予算のない方は、同時に開いているブックを[ 表示 ]のタブの[ 整列 ]機能で表示
方法を左右に分割して表示して作業をします。 | ||
3.3個のブックを同時に開き、ユーザーフォームのボタンクリックで正しくクリックしたブッ
クを認識するか試しみました。 |
||
[ マクロの表紙 ]については、[ 仕事に役立つExcelマクロの作り方 ]とそのページ内の | ||
4. ブックを閉じる順序で、[ アドイン ]の[ メニューバー ]が、残ってします現象の対策。
Application.DisplayAlerts = False ' 警告メッセージをオフにする
Workbooks("ブック名_A").Save ' 上書き保存
Workbooks("ブック名_A").Close ' ブック名_A を閉じる
Workbooks("マクロのブック名").Save ' マクロブックを保存する時
Application.Quit ' マクロブック・Excel の終了
Application.DisplayAlerts = True ' 警告メッセージをオフ解除する | ||
5. マクロで別ブックをアクティブにしてもアクティブならない時の対策。 Workbooks("〇〇〇〇.xlsx").Activate ' ユーザーフォームから、フォーカス( アクティブ状態 )を ' ブックに移す処理 VBA.AppActivate Excel.Application.Caption
このステートメントは、アクティブにしたブックを最前面に表示したいときにも有効です。 | ||
6. 複数ブック使用時の Hide ( ユーザーフォームの非表示 )を使用するときの注意。 | ||
〇 これらの配慮や工夫は、私のスキル内で思いつき工夫した事・経験した事です。もっと良い方法が
あれば教えていただければ幸いです。 また、良い方法が、見つかりましたら追加していきます。 |
2. 写真の貼り付け |
||
( 3項 [ 写真貼付マクロ ] [ 写真読込マクロ ] のダウンロード版で紹介 ) | ||
写真の挿入貼付でリンク貼付になるのを修正しました。( 先人の知恵を借用しました。) |
貼付のマクロは、下記の様に記述します。 修正前 ActiveSheet.Pictures.Insert(myFname).Select ( myFname : 貼付写真のパス ) 修正後 Set objShape = ActiveSheet.Shapes.AddPicture( _ Filename:=myFname, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left, _ Top:=Selection.Top, _ width:=Tate, height:=Yoko) |
||
AddPicture の使い方の詳細は、下記で解説しています。 | ||
(1) AddPicture を使用した写真の貼り付け ' 写真を貼付けるセルをアクティブ( 選択 )して、貼付け場所の 縦・横位置、高さ・横幅を取得します。 ActiveSheet.Cells(X, Y).Select <--- X, Y は、写真を貼り付ける セルの位置データです。 ' With Selection yoko = .Left <--- 挿入する写真の左端位置を取得 tate = .Top <--- 挿入する写真の上端位置を取得 Wyoko = .Width <--- 挿入する写真の横幅を取得 Wtate = .Height <--- 挿入する写真の高さを取得 End With ' ダイアログボックスを表示して貼り付ける写真を選択させると供に 指定写真のフルパスデータを取得する。 myFname = Application.GetOpenFilename _ ("写真ファイル(*.JPG;*.JPEG),*.JPG;*.JPEG") 他の画像ファイルにも対応させたい時には、 ("写真ファイル(*.JPG;*.JPEG;*.BMP;*.GIF;*.WMF) ,*.JPG;*.JPEG;*.BMP;*.GIF;*.WMF") '---------------------------------------------------------------- ' 写真を貼り付け ' Shapes.AddPictureメソッドの引数は全て設定しないと動作しません。 ' 注意してください。 '---------------------------------------------------------------- 同一写真について処理するので With ~ End with でくくる。
With ActiveSheet.Shapes.AddPicture( _ '------------------------------------------------------------ ' 写真を所定のサイズに変更する '------------------------------------------------------------ ' 写真のサイズ取得する。 x2 = .Width y2 = .Height ' 写真の拡大/縮小率を計算してサイズを変更する。 .ScaleWidth (Wyoko / x2), msoTrue .ScaleHeight (Wtate / y2), msoTrue ' 張付けた写真の上に文字・線等が書けるように、写真の表示順序を ' 最背面にします。 .ZOrder msoSendToBack End With (2) AddPicture を使用した写真の貼り付け ( 上記マクロを簡素化してみました。 ) objShape を図形のオブジェクト名にする。 Dim objShape As Shape ( 省略 ) 貼付け場所のセルをマウスでアクティブにするか、下記の様にプログラムで アクティブにします。 X, Y は、写真を貼り付けるセルの位置データです。 ActiveSheet.Cells(X, Y).Select ダイアログボックスを表示して貼り付ける写真を選択させると供に指定写真のフルパスデータを取得する。 myFname = Application.GetOpenFilename _ ("写真ファイル(*.JPG;*.JPEG),*.JPG;*.JPEG") Set objShape = ActiveSheet.Shapes.AddPicture( _ filename:=myFname, _ <--- 挿入する写真ファイル名を パス付きで指定 LinkToFile:=False, _ <--- False で独立した写真と しての指定 SaveWithDocument:=True, _ <--- True で Excelファイルと 共に保存 Left:=Selection.Left, _ <--- アクティブセルの 左端位置を指定 ( アクティブなセルの [ X 座標 ] 横位置座標 ) Top:=Selection.Top, _ <--- アクティブセルの 上端位置を指定 ( アクティブなセルの [ Y 座標 ] 縦位置座標 ) Width:=Selection.width, _ <--- アクティブセルの横幅を指定 Height:=Selection.height) <--- アクティブセルの高さを指定
※※ おまけの情報 ※※ Dim objShape As Shape <--- objShape を図形の オブジェクト名にする。 ( 省略 ) objShape.Name = "○○○○" <--- Picture1 とかの名前を付ける。 参照の仕方(一例) With ActiveSheet.Shapes("Picture1") LockAspectRatio プロパティに Falseを指定すると図形の縦横比を 自由変更にする事が出来ます。 msoTrue で 図形の縦横比を固定する。 .LockAspectRatio = msoFalse .Width = 150: .Height = 200 <--- 横・縦の幅を変更する。 End With
② 写真を 90°回転する時の貼付け座標値の補正計算 |
||
マクロの記述は、下記の様になります。 Dim objShape As Shape <--- objShape を図形の オブジェクト名にする。 ( 省略 ) myFname = Application.GetOpenFilename( _ "写真ファイル(*.JPG;*.JPEG),*.JPG;*.JPEG") With Selection yoko = .Width <--- アクティブセルの横幅を取得 tate = .Height <--- アクティブセルの高さを取得 End With '--------------- 90°回転する時の処理----------------------- Set objShape = ActiveSheet.Shapes.AddPicture( _ Filename:=myFname, _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left - Tate / 2 + Yoko / 2, _ Top:=Selection.Top + Tate / 2 - Yoko / 2, _ Width:= yoko, _ Height:=tate) objShape.Rotation = 90 <--- 時計回りの方向に 90°回転します。 |
||
(3) 貼付け写真を変更( サイズ変更・削除等 )出来ないように固定する方法 Sub ○○○○() Dim Abc As Single ' いきなり実行するのではなく、確認をしてから実行します。 Abc = MsgBox("このページの写真変更禁止を設定します。 _ ", vbYesNo, "写真変更禁止確認") If Abc = vbNo Then Exit Sub <--- Noの時終了 '--------------------------------------------------------- ActiveSheet.Unprotect <--- 一度シート保護を解除します。 Cells.Select <--- シート全体を選択します。 Selection.Locked = False <--- シート全体のセルの保護ロック フラグをOFFする ' セル範囲("B2:G42")を保護する。 Range("B2:G42").Select <--- 写真を張付けたセル範囲を選択 します。 Selection.Locked = True <--- 選択されたのセルの保護ロック フラグをONする ActiveSheet.Protect userinterfaceonly:=True <--- マクロからの 書換は、可能にする Range("A1").Select MsgBox ("写真変更禁止完了") <--- 終了メッセージ End Sub
上記の写真張付け方法で作成した、「写真張付マクロ」と写真一覧表を
作成する「写真読込マクロ」を公開しています。 |
【 写真貼付マクロをダウンロードする 】 | ( ダウンロード数: 5387 ) | |
【 写真読込マクロをダウンロードする 】 | ( ダウンロード数: 2520 ) |
3. 新規に○○○○.xlsx, ○○○○.xls で保存する。 |
||
○ ポイント 1 ( 3項 [ 写真貼付マクロ ] のダウンロード版で紹介 ) ' Dpath 格納先のパス Fname ブック名 AAA = Dpath & "\" & Fname & ".xlsx" ○○○○.xlsxだけを使用するのであれば、下記の処理は、不要です。 '------------------------------------------------------------- ' Excel 2007・2010 対策 書込み時に、拡張子の指定がいる。 ' 51=*.xlsxモードで保存 '------------------------------------------------------------- ActiveWorkbook.SaveAs Filename:=AAA, FileFormat:=51 ' ActiveWorkbook.SaveAs AAA <--- Excel2003では、 これだけで済んでいました。 ○ ポイント 2 Excel2002・2003等の拡張子( ○○○○.xls )で保存する方法。 '-------------------------------------------------------------- ' ここは、参考資料です。 ' Excel ブックのファイルフォーマットコード '43 = xlExcel9795 '51 = xlOpenXMLWorkbook (without macro's in 2007, xlsx) '52 = xlOpenXMLWorkbookMacroEnabled ' (with or without macro 's in 2007, xlsm) '50 = xlExcel12 (Excel Binary Workbook in 2007 with or without ' macro 's, xlsb) '56 = xlExcel8 (97-2003 format in Excel 2007, xls) ' Excelのバージョンコード ' Code=Val(Application.Version) で調べられます。 ' 9: sv = "2000" '10: sv = "2002" '11: sv = "2003" '12: sv = "2007" '14: sv = "2010" '15: sv = "2013" '16: sv = "2016", "2019" '---------------------------------------------------------- ' Excel2007でExcel2003等のファイルを ' 旧バージョンのまま保存するときの処理 '---------------------------------------------------------- AAA = Dpath & "\" & Fname & ".xls" <--- 拡張子を書込む バージョンに合わせる。 Application.DisplayAlerts = False <--- 警告メッセージを 停止する指定 ' 56 : Excel97-2003 ActiveWorkbook.SaveAs Filename:=AAA, FileFormat:=56 Application.DisplayAlerts = True <--- 警告メッセージを停止解除 |
4. すぐ使えるExcel2010・2019対応マクロのダウンロード。 |
||
○ 本ページで、解説した内容を盛り込んで作成したマクロを公開しています。 | ||
すぐ使えるExcel2010・2019対応マクロ |
1.【 写真貼付マクロをダウンロードする 】 | ( ダウンロード数: 5387 ) | |
2.【 写真読込マクロをダウンロードする 】 | ( ダウンロード数: 2520 ) | |
3.【 簡易 CADマクロをダウンロードする 】 | ( ダウンロード数: 3484 ) | |
4.【 シート操作マクロをダウンロードする 】 | ( ダウンロード数: 2331 ) | |
5.【 セル操作マクロをダウンロードする 】 | ( ダウンロード数: 2158 ) | |
6.【 印刷マクロをダウンロードする 】 | ( ダウンロード数: 1680 ) | |
7.【 給与計算マクロ( 見本 )をダウンロードする 】 | ( ダウンロード数: 1835 ) | |
8.【 検索住所マクロ( 見本 )をダウンロードする 】 | ( ダウンロード数: 1612 ) | |
9.【 自動処理シートマクロをダウンロードする 】 | ( ダウンロード数: 1331 ) | |
10.【 出勤台帳作成マクロをダウンロードする 】 | ( ダウンロード数: 1592 ) |
[注意事項] H24.11.10 追記 |
※ 警告の解除方法 ※ |
○ 一つ目は、ダウンロードしたマクロの危険性の警告です。 これは、[編集を有効にする(E)]をクリックしてください。 |
5. すぐ使えるフリーのExcel2010・2019対応マクロの解説。 |
||
○ 上記 3項で、ダウロードできるマクロに関して、解説ページを作りました。 |
1.【 写真貼付付マクロの解説を見る 】 | ( アクセス数: 17,423 ) | |
2.【 写真読込マクロの解説を見る 】 |
( アクセス数: 9,945 ) | |
3.【 簡易 CADマクロの解説を見る 】 |
( アクセス数: 11,724 ) | |
4.【 シートの操作マクロの解説を見る 】 |
( アクセス数: 8,280 ) | |
5.【 セル操作マクロの解説を見る 】 |
( アクセス数: 6,821 ) | |
6.【 給与計算(見本)マクロの解説を見る 】 |
( アクセス数: 10,765 ) | |
7.【 印刷マクロの解説を見る 】 |
( アクセス数: 8,982 ) | |
8.【 コピー名前変更マクロの解説を見る 】 |
( アクセス数: 4,370 ) |
6. シートコピーが、エラーになる時の対処方法。 |
||
○ ポイント ( 3項 [ 写真張付マクロ ] のダウンロード版で紹介 )
マクロでシートをコピーさせたときに、共有ファイルでエラーが出ることがあります。 '------------------------------------------------------------------ ' Excel 2007・2010 対策 ' ブックの共有解除をしないとシートコピーできない。 Application.DisplayAlerts = False <-- 警告メッセージを停止する指定 If ActiveWorkbook.MultiUserEditing Then _ ActiveWorkbook.ExclusiveAccess Application.DisplayAlerts = True <-- 警告メッセージを停止する解除 '------------------------------------------------------------------ ' シート名に枝番を付けてコピーするサブルーチン( 例 ) ' ここでコピーしたいシートをアクティブにしておきます。 Worksheets(○○○○).Activate <---- ○○○○はシート名 シートコピー ' ( 途中処理省略 ) ' Sub シートコピー() ' Fname = ActiveSheet.Name <--- シート名の取得する SS = Len(Fname) <--- シート名の文字数を取得する ' 関数 InStr でシート名に枝番( -n )があるかをチェックする。 N = InStr(1, Fname, "-") S1 = SS - N + 1 <--- 枝番の文字を計算する If N <> 0 Then BBB = Left(Fname, SS - S1) <--- 枝番を取ったのシート名を ' を取得する HH = Right(Fname, SS - N) <--- 枝番だけの文字列を取得する NN = Val(HH) <--- 文字列を数値に変換する AAA = BBB & "-" & CStr(NN + 1) <--- 追加枝番のシート Else 名を作成する AAA = Fname & "-" & CStr(1) <--- シートの数が、1 の時、 End If 枝番 -1 を作る ' Application.DisplayAlerts = False <--- 警告メッセージ表示を ' ここで、シートを後ろへ追加する。 停止する。 mm = ActiveSheet.Name Sheets(mm).Copy After:=Sheets(mm) CCC = ActiveSheet.Name Worksheets(CCC).Name = AAA <--- シート名の変更する Application.DisplayAlerts = True <--- 警告メッセージ表示を ' 有効にする。 End Sub |
7. 任意のセルを保護する方法 |
||
○ 任意のセルの保護をする。( 3項 [ セル操作マクロ ] のダウンロード版で紹介 ) ActiveSheet.Unprotect <-- 一度シート全体の保護を解除 Cells.Select <-- シート全体を選択 一度すべてのセルの「保護のロックフラグ」を OFF する Selection.Locked = False 保護するセルの範囲をアクティブにする Range("保護するセルの範囲").Select ( 保護するセルの範囲が複数ある場合には、「,」を入れて定義します。 ex."O3:T5,O8:P21,O24:U30") Selection.Locked = True> <-- セル保護のロックフラグを ON する ' セル保護のロックフラグに従ってセルを保護する。 但し、「マクロからの変更は可能」に設定する。 ActiveSheet.Protect Contents:=True, userinterfaceonly:=True 3. 指定したセル以外のセルに、保護を掛ける。 ActiveSheet.Unprotect Cells.Select 一度すべてのセルの「保護のロックフラグ」を ON する Selection.Locked = True Range("保護するセルの範囲").Select Selection.Locked = False <-- セル保護のロックフラグを OFF する ActiveSheet.Protect Contents:=True, userinterfaceonly:=True
に、変更すると、選んだ範囲外に保護が掛かります。 ActiveSheet.Unprotect <-- シートの保護解除 Cells.Select <-- シート全体を選択 Selection.Locked = False <-- セルのロックフラグを OFF する Range("A1").Select <-- シート全体を選択状態を解除
○ ここでは、逆に保護のかかったセルを視覚的に確認(セルに色付け)出来るようにする方法 If CL_Range.Locked = True Then セルに保護がかかっている時の処理をする。 ' セルに色を付ける Range(CL_Range).Select <---- セルを選択 With Selection.Interior .Pattern = xlSolid <---- 塗りつぶし ' 参考 パレット番号( 色コード ) ' 1: 黒, 2: 白, 3: 赤, 4: 明るい緑, 5: 青 ' 6: 黄, 7: ピンク, 8: 水色, 9: 濃い赤 ' 10: 緑, 11: 濃い青, 12: 濃い黄, 13: 紫 ' 14: 青緑, 15: 25%灰色, 16: 50%灰色 ' 26: ピンク, 28: 水色, 33: スカイブルー ' 43: ライム, 44: コールド, 46: オレンジ .ColorIndex = 6 <---- 色指定 黄色(ColorIndex番号) End With RGBコードでは、.Color = RGB(255, 255, 0) End If と書きます。 ※ 文字に色を付ける時は、下記の様に書きます。 ※ ActiveSheet.Cells(y, x).Select <-- 文字に色を付けるセル (y, x)を選択 Selection.Font.ColorIndex = 3 <-- 文字の色 赤
パレット番号( 色コード ) ColorIndex 番号・10進コード・RGB コード 一覧表 |
||
上記のコード 一覧表を作成するマクロの詳細は、下記をクリックしてみてください。 |
||
※ 参考情報 ※ 図形の色コード ColorIndex 番号・10進コード・RGB コード 一覧表 |
||
上記の図形の色コード表の作成方法は、上記のマクロに記述してあります。 ' 文字に色を付ける ActiveSheet.Cells(y, x).Font.ColorIndex = ( 色コード ) ( y: セルの縦位置 x: セルの横位置 ) または、 ActiveSheet.Cells(y, x).Select Selection.Font.ColorIndex = ( 色コード ) Selection.Cells.Font.FontStyle = "標準" <-- 文字の太さを標準に Selection.Cells.Font.FontStyle = "太字" <-- 文字を太字に Selection.NumberFormatLocal = "@" <-- セルを文字列に Selection.NumberFormatLocal = "0_ " <-- セルを数値に
4. 上記をプログラムとして作成した例です。 | ||
AAname : マクロのブック名 BBname : マクロの表紙のシート名 です。 Dim CL_Range, C_Range As Variant <-- Variant で宣言してください。 ( 途中処理省略 ) Sub ○○○○() <-- フォームのボタン等をクリックしたら、 ' ここへジャンプさせる。 ' 保護のかかったセルの抽出。 Locked_Cell_get End Sub ( 途中処理省略 ) Sub ××××() <-- フォームのボタン等をクリックしたら、 ' ここへジャンプさせる。 ' 色付けしたセルのいろを消す。 Cell_Color_off End Sub ( 途中処理省略 ) | ||
保護のかかったセルをリストアップしてセルに色を付けるサブルーチン。 Sub Locked_Cell_get()
※ 補足 ※ ' ドラック範囲を取得 ' サブルーチン[ Range_data ]は、「7. インプットボックスで、 ' セル参照結果を取得する方法」で解説しています。 Range_data AAA, BBB C_Range = AAA & ":" & BBB <-- ドラック範囲のアドレス '----------------------------------------------------------- ' 「表紙」のリストデータ消去 データの個数を取得 N = Workbooks(AAname).Sheets(BBname).Cells(2, 15).Value ※ 補足 ※ リストデータのカウントは、シート「表紙」のセル(2,15)に 関数 [=COUNTA(R[1]C:R[99998]C)+2]を書込み、 カウントさせています。 if N >2 then <-- N = 2 の時は、データなし For i = 3 To N Workbooks(AAname).Sheets(BBname).Cells(i, 15).Value = "" Next i End If '----------------------------------------------------------- ' 保護のかかったセルをリストアップする。 II = 3 ' ドラックされたセル範囲をすべて検査する。 For Each CL_Range In ActiveSheet.Range(C_Range) ' 保護なし: False, 保護有: True If CL_Range.Locked = True Then ' 保護のかかっているセル位置データをリストアップする。 ' A1,AB10 というレンジデーとして取得するため、Address に ' (False,False) を付けます。 Workbooks(AAname).Sheets(BBname).Cells(II, 15).Value = _ CL_Range.Address(False,False) II = II + 1 End If Next '----------------------------------------------------------- ' リストアップしたセルに色を付ける。 N = Workbooks(AAname).Sheets(BBname).Cells(2, 15).Value if N >2 then <-- N = 2 の時は、データなし For II = 3 To N ' リストから、セル位置データを読み出す。 CL_Range = \ Workbooks(AAname).Sheets(BBname).Cells(II, 15).Value Range(CL_Range).Select <-- セルを選択 ' セルに色を付ける With Selection.Interior .Pattern = xlSolid <-- 塗りつぶし ' 参考 色コード 1: 黒, 2: 白, 3: 赤, 4: 明るい緑 ' 5: 青, 6: 黄, 7: ピンク, 8: 水色 .ColorIndex = 6 <-- 色指定 黄色 End With Next II End If End Sub | ||
ドラッグした範囲の始まり位置・終わり位置を取得するサブルーチン。 Sub Range_data(AAA, BBB As Variant) Dim Hogo_range As Range <-- 変数をレンジ型変数にする。 Dim XXX As Variant <-- 変数をバリアント型変数にする。 'インプットボックスで範囲を選択させます。 Set Hogo_range = _ Application.InputBox(prompt:="範囲をドラッグ", Type:=8) '------------------------------------- ' Address(False, False)で ' A1参照形式のレンジデータが取得できます。 CCC = Hogo_range.Address(False, False) XXX = Split(CCC, ":") <-- レンジデータの区切り文字( : )で分割 配列データとして XXX に代入します。 AAA = XXX(0) <-- ドラッグ範囲の始まり位置を取得します。 BBB = XXX(1) <-- ドラッグ範囲の終わり位置を取得します。 '------------------------------------- ' 変数 AAA と BBB にドラッグ範囲の始まりと終わり位置が ' A1参照形式のレンジデータとして取得できます。 End Sub | ||
リストアップしたセルの色を消すサブルーチン。 Sub Cell_Color_off() ' リストアップしたセルの色を消す。 データの個数を取得 N = Workbooks(AAname).Sheets(BBname).Cells(2, 15).Value if N >2 then <---- N = 2 の時は、データなし For II = 3 To N ' リストから、セル位置データを読み出す。 CL_Range = _ Workbooks(AAname).Sheets(BBname).Cells(II, 15).Value Range(CL_Range).Select <--- セルを選択 Selection.Interior.Pattern = xlNone <--- 塗り Next II つぶしなし End If End Sub
上記の写真張付け方法で作成した、「セル操作マクロ」を公開しています。 |
( ダウンロード数: 2158 ) |
8. インプットボックスで、セル参照結果を取得する方法 |
||
○ インプットボックス( InputBox )で、セル参照 (Range オブジェクト)をするには、Typeを 8 にして行います。 | ||
(1) セルのアドレスを取得する(Addressプロパティ)を使用してセル参照範囲を取得する方法。 Sub H_Range(AAA, BBB As Variant) Dim Hogo_range As Range <-- 変数をレンジ型変数にする。 Dim XXX As Variant <---- 変数をバリアント型 'インプットボックスで範囲を選択させます。 変数にする。 Set Hogo_range = _ Application.InputBox(prompt:="範囲をドラッグ", Type:=8) '------------------------------------- 'ddress(False, False)でA1参照形式のレンジデータが取得できます。 CCC = Hogo_range.Address(False, False) XXX = Split(CCC, ":") <-- レンジデータの区切り文字( : )で 分割配列データとして XXX に代入します。 AAA = XXX(0) <-- ドラッグ範囲の始まり位置を取得します。 BBB = XXX(1) <---ドラッグ範囲の終わり位置を取得します。 '------------------------------------- 変数 AAA と BBB にドラッグ範囲の始まりと終わり位置がA1参照形式のレンジデータとして取得できます。 End Sub
| ||
(2) 単純に計算式でセル参照範囲を取得する方法。 Set Hogo_range = Application.InputBox(prompt:= _ "保護する範囲をドラッグしてください", Type:=8) ' 再度ドラッグされた範囲を選択する。 Hogo_range.Select ' RangeSelectionで選んだセル範囲の位置(番号)を取得します。 With ActiveWindow.RangeSelection y1 = .Columns.Column y2 = .Columns(.Columns.Count).Column x1 = .Rows.Row x2 = .Rows(.Rows.Count).Row End With ' y1 の値から、A1参照形式 An ~ Zn , AAn ~ に変換する。 ' セル位置 Z(26) の次は、AA(27)、AZ(52) の次は、BA(53)になる。 ' この処理を、下記で行う。アルハベット A ~ Z が、26文字で ' あることに着目して処理をする。 ' Chr(64 + y1)は、10進コードで文字に変換するマクロ。 ' Chr(64 + 1) --> A ' Chr(64 + 2) --> B,・・・ ' Chr(64 + 26) --> Z の文字になります。 ' セル範囲の始まり | ||
計算式によって、y1 の値から、A1参照形式 An ~ Zn , AAn ~ に変換するプログラム。 M1 = Int(y1 / 26): M2 = y1 Mod 26 If M2 = 0 Then M1 = M1 - 1: M2 = 26 ' ドラック範囲の開始セル位置の算出 If M1 = 0 Then ' セル位置、An ~ Zn の計算 AAA = Chr(64 + M2) & x1 Else ' セル位置、A○n ~ Z○n の計算 AAA = Chr(64 + M1) & Chr(64 + M2) & x1 End If ' ドラック範囲の終了セル位置(y2)の値から、A1参照形式を算出 M3 = Int(y2 / 26): M4 = y2 Mod 26 If M4 = 0 Then M3 = M3 - 1: M4 = 26 If M3 = 0 Then ' セル位置、An ~ Zn の計算 BBB = Chr(64 + M4) & x2 Else ' セル位置、A○n ~ Z○n の計算 BBB = Chr(64 + M3) & Chr(64 + M4) & x2 End If
変数 AAA と BBB にドラッグ範囲の始まりと終わり位置がA1参照形式のレンジデータとして取得
できます。 | ||
セル範囲を拡大したい方のため、AAA(703) ~ XFD(16384)に対応させるマクロの記述例を紹介して
おきます。 | ||
下記は、セル範囲 A(1) ~ XFD(16384) まで対応させた計算式のマクロです AAA = "": BBB = "" ' If (y1 - 702) < 0 Then <-- A ~ ZZ(702) と ' A ~ ZZ の処理 AAA ~ XFD(16384) の範囲の判定 M1 = Int(y1 / 26): M2 = y1 Mod 26 If M2 = 0 Then M1 = M1 - 1: M2 = 26 ' If M1 = 0 Then AAA = Chr(64 + M2) & x1 Else AAA = Chr(64 + M1) & Chr(64 + M2) & x1 End If ' Else ' AAA ~ XFD の処理 M = y1 - 26 <-- A ~ Z の分を引く ' 676は、AAからZZまでのセルの数 ' 3桁のセル位置を①②③で表すと ①は、Chr(64 + M1) ' ②は、Chr(64 + M3) ' ③は、Chr(64 + M4) で A ~ Z の文字を作っています。 M1 = Int(M / 676): M2 = M Mod 676 ' ' 二桁目②が A の時、M3=0 になるので 26(A ~ Z = 26) を加算する。 ' (M3=0時、Chr(64 + 1)つまり、A にするため) ' M ÷ 676 の余りが無いときは、Z にするため、M3 = 26 にする事と ' M1 の値が 1 多くなるため。 M3 = Int((M2 + 26) / 26): If M2 = 0 Then M1 = M1 - 1: M3 = 26 ' AAA = Chr(64 + M1) M4 = M2 Mod 26: If M4 = 0 Then M4 = 26 ' 個別に作った文字①②③を合成する。 ' ドラッグ範囲の始まり位置を取得します。 AAA = AAA && Chr(64 + M3) & Chr(64 + M4) & x1 ' End If 変数 AAA にドラッグ範囲の始まり位置がA1参照形式のレンジデータとして取得できます。 ' If (y2 - 702) < 0 Then ' A ~ ZZ の処理 M3 = Int(y2 / 26): M4 = y2 Mod 26 If M4 = 0 Then M3 = M3 - 1: M4 = 26 ' If M3 = 0 Then BBB = Chr(64 + M4) & x2 Else BBB = Chr(64 + M3) & Chr(64 + M4) & x2 End If ' Else ' AAA ~ XFD の処理 M = y2 - 26 <-- A ~ Z の分を引く ' M1 = Int(M / 676): M2 = M Mod 676 M3 = Int((M2 + 26) / 26) If M2 = 0 Then M1 = M1 - 1: M3 = 26 ' BBB = Chr(64 + M1) M4 = M2 Mod 26: If M4 = 0 Then M4 = 26 ' ドラッグ範囲の終わり位置を取得します。 BBB = BBB & Chr(64 + M3) & Chr(64 + M4) & x2 End If
変数 BBB にドラッグ範囲の終わり位置がA1参照形式のレンジデータとして取得できます。 |
9. ファイル( 写真等 )を指定したフォルダへのコピーと名前変更する方法 |
||
○ コピーと名前変更するときには、Windows Script Host Object Model を使用しているので、
[マクロ] - [ツール] - [参照設定]で上記のオブジェクトにチェックを入れて、使用すること。 |
【 コピー名前変更マクロ( 見本 )を ダウンロードする 】 |
( ダウンロード数: 981 ) |
下記に、プログラム例を示します。
| ||
'------------------------------------------------------ ' 書込み先のフォルダが有るかチェックする ' 同一のファイル名がないかチェックする '------------------------------------------------------ 「ネットワークドライブの参照」についてのは、「 8. 仕事に役立つExcelマクロの作り方 」で 詳しく解説しています。 ' ネットワークドライブの参照 Public Declare Function SetCurrentDirectory _ Lib "kernel32" Alias "SetCurrentDirectoryA" _ (ByVal lpPathName As String) As Long ( 省略 ) ' Fname2=( 書込み先のフォルダのパス ) ' CCC=( コピーするファイル名 ) ' Fname3 = Fname2 & CCC & ".jpg" ' With New IWshRuntimeLibrary.FileSystemObject ' ' Fname2=( 書込み先のフォルダのパス ) ' BBB=( 読込先のフォルダのパス ) ' ' 書込み先のフォルダが有るかチェックする ' If Not .FolderExists(Fname2) Then vbExclamation <-- 注意メッセージアイコンを表示させます。 MsgBox "コピー先のフォルダ" & BBB & "が見つかりません。", _ vbExclamation GoTo ( エラーの時の処理へ、ジャンプ ) End If ' ' 同一のファイル名がないかチェックする ' If Not .FileExists(Fname3) Then a = a <---- デバック用のブレーキングポイントのダミー Else MsgBox "同一ファィル「 " & CCC & " 」があります。", _ vbExclamation GoTo ( エラーの時の処理へ、ジャンプ ) End If ' End With '------------------------------------------------------ ' 指定フォルダへ、書き込む '------------------------------------------------------ With New IWshRuntimeLibrary.FileSystemObject ' ' Fname1=( 読込側のパス + ファイル名 ) ' Fname2=( 書込み先のフォルダのパス ) ' .CopyFile Fname1, Fname2, True ' End With '------------------------------------------------------ ' 名前変更 '------------------------------------------------------ ' 書込み側のパス設定 ADir = ( 書込み側のパス ) ' カレントディレクトリの設定 If ADir <> "" Then If Left(ADir, 2) = "\\" Then ' ネットワークドライブの参照 Call SetCurrentDirectory(ADir) Else ' PC内のカレントディレクトリの変更は、ChDrive と ChDir との ' セットで行う。 ChDrive Left(ADir, 2) <-- PC内ドライブの参照 ChDir ADir <-- ドライブ内のパスの参照 End If End If ' ' Sname=( 変更前のファイル名 ) CCC=( 変更後のファイル名 ) ' DirA = Sname: DirB = CCC & ".jpg" ' Name DirA As DirB |
10. マクロで設定したアドイン メニューコマンドが消えずに残った時の対処方法 |
||
マクロで設定したメニューコマンド( マクロを起動させるためのメニューの起動用ボタン )が消えず
に残った時には、「セルの操作マクロ」の中にある[ 不要メニュー消去 ]のボタンをクリックすると
簡単に消すことができます。 Application.CommandBars("Worksheet Menu Bar").Reset 個別にメニュー項目を指定して消去するには、下記の様にします。 CommandBars("Worksheet Menu Bar")
_.Controls("[メニュー項目]").Delete
※※ 参考情報 ※※ |
11. 動的配列変数という変数を知っていますか??? |
||
H25.06.11 追加 | ||
[ドラッグ範囲を追加シートへコピーするマクロ]のプログラムの例です。 Dim Bname, Sname, CCC As String Dim x1, y1, x2, y2 As Long Dim N As Single Dim Takasa() As Variant <-- 動的配列変数の使用を宣言する。 Dim Haba() As Variant ' Sname = ActiveSheet.Name <-- コピー元シート名退避 ' ドラックされた範囲の始点位置・大きさを取得する。 With ActiveWindow.RangeSelection x1 = .Columns.Column <-- 横方向の始点 x2 = .Columns(.Columns.Count).Column <-- 横方向のセル数 y1 = .Rows.Row <-- 縦方向の始点 y2 = .Rows(.Rows.Count).Row <-- 縦方向のセル数 End With '------------------------------------------------------------- ' 動的配列変数の宣言 ' ReDim Takasa(y2) <-- 動的配列変数の要素数を決める。 ReDim Haba(x2) '------------------------------------------------------------ ' ドラックされた範囲のセルの高さを取得して配列へ代入する。 For N = y1 To y2 Takasa(N) = Selection.Rows(N).RowHeight Next N ' ドラックされた範囲のセルの幅を取得して配列へ代入する。 For N = x1 To x2 Haba(N) = Selection.Columns(N).ColumnWidth Next N '------------------------------------------------------------ Sheets.Add <-- シートを追加する。 CCC = ActiveSheet.Name <-- 追加シート名退避 ' Worksheets(Sname).Activate <-- コピー元シート開く Selection.Copy <-- ドラック範囲をコピーする。 ' 追加シートをオープンする。 Worksheets(CCC).Activate <---- 新規シートを開く '------------------------------------------------------------ Application.ScreenUpdating = False <-- 画面更新を停止する。 Cells(y1, x1).Select <-- 張付ける始点を指定する。 '------------------------------------------------------------ 'Selection.PasteSpecial Paste:=xlValues '値の貼付 'Selection.PasteSpecial Paste:=xlFormats '書式の貼付 'Selection.PasteSpecial Paste:=xlFormulas '数式の貼付 '------------------------------------------------------------ ' Operation:=xlNone,演算は「行わない」(Operation:=xlNone) ' SkipBlanks:=False 「空白を 無視する」 はオフ ' Transpose:=False 「行列を入れ替える」はオフ '------------------------------------------------------------ ' セルの値のみ貼付け Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False '------------------------------------------------------------ ' セルの書式のみ貼付け Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False '------------------------------------------------------------ ' 数式の貼付をする時は、下記行を有効にする 'Selection.PasteSpecial Paste:=xlFormulas, _ 'Operation:=xlNone, SkipBlanks:=False, Transpose:=False '------------------------------------------------------------ ' 配列へ代入されたセルの高さを読出し同じセル位置に復元する。 For N = y1 To y2 Rows(N).RowHeight = Takasa(N) Next N ' 配列へ代入されたセルの幅を読出し同じセル位置に復元する。 For N = x1 To x2 Columns(N).ColumnWidth = Haba(N) Next N '------------------------------------------------------------ ' ゼロを表示しない指定は、下記行を有効にする。 ' ActiveWindow.DisplayZeros = False '------------------------------------------------------------ Application.ScreenUpdating = True <-- 画面更新を停止を解除する。 Range("A1").Select |
12. 出勤台帳・日報等作成時、マクロでの年月日の扱い方 |
||
出勤台帳・日報等作成使用とする、月末の処理・土日の処理をしなければなりません。これらをマク
ロでする時には、下記の様にします。 Dim YYMMDD, YY, MM, DD As String <-- 変数を文字列型で宣言 Dim E_date As Date <-- 変数を日付型型で宣言 Dim EE, N As Integer <-- 変数を整数型で宣言 ' YY は、通常西暦ですが、和暦 H25 でもOKです。 YYMMDD = YY & "/" & MM & "/" & DD <-- 日付型データを作る。 ' ( yyyy/mm/dd ) ' 指定月(YYMMDD)の末日の年月日を取得する関数への設定 E_date = DateSerial(Year(YYMMDD), Month(YYMMDD) + 1, 0) EE = Day(E_date) <-- 日付データから日を求める関数、
' 月末の日を知る。
※※ 参考情報 ※※ DateSerial(Year(Date), Month(Date), 0) 今月の月末日を知る。 DateSerial(Year(Date), Month(Date) + 1, 0) 翌月の月末日を知る。 DateSerial(Year(Date), Month(Date) + 2, 0) ② 曜日を知る方法 YYMMDD = YY & "/" & MM & "/" & DD <-- 日付型データを作る。 ' ( yyyy/mm/dd ) N = Weekday(YYMMDD) <-- 何曜日かを教えてくれる関数
Weekday(YYMMDD) の戻り値 日= 1,月 = 2,火 = 3,水 = 4,木 = 5,金 = 6,土 = 7 | ||
ex. 曜日を判定して、書き込んだ日にちの文字に色を付けるプログラム N = Weekday(YYMMDD) <-- 曜日を抽出 ' III = Day(YYMMDD) <-- 日にちを抽出 ' ActiveSheet.Cells(y, x).Value = III <-- 日を設定 ActiveSheet.Cells(y, x).Select <-- セル(y, x)を選択 ' Select Case N Case 1 ' Sunday ' 色コード 1: 黒, 2: 白, 3: 赤, 4: 緑 ' 色コード 5: 青, 6: 黄, 7: マゼンタ, 8: 水色 Selection.Font.ColorIndex = 3 <-- 赤 Case 7 ' Saturday Selection.Font.ColorIndex = 5 <-- 青 End Select ' With Selection <-- 文字をセルのセンターに表示させる。 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With | ||
③ マクロでの年月日の扱い方 ( D_date は、日付型変数 ) YY = Format(D_date, "yyyy") <--- 西暦 2019
YY = Format(D_date, "ge") <--- 和暦 H○ or R○
YY = Format(D_date, "ggge") <--- 和暦 平成○ or 令和○
MM = Format(D_date, "mm") <--- 月 01 ~ 12
MM = Format(D_date, "m") <--- 月 1 ~ 12
DD = Format(D_date, "dd") <--- 日 01 ~ 31
DD = Format(D_date, "d") <--- 日 1 ~ 31 ※※ 参考情報 ※※ 日付の書式記号 ( 日付の例は、2019/5/1,和暦の例は、令和 1 年 ) ( 2019/4/30 までは、平成 ) ------------------------------------------------------------
| 種 類 | 記 号 | 表示例 | 記 号 | 表示例 | 記 号 |
------------------------------------------------------------
| 西 暦 ( 年 ) | yy | 19 | yyyy | 2019 | |
| 和 暦 ( 元号 ) | g | H , R | gg | 平, 令 | ggg |
| 和 暦 ( 年 ) | e | 1 | ee | 01 | |
------------------------------------------------------------
| 月 | m | 7 | mm | 07 | mmm |
| 日 | d | 6 | dd | 06 | |
------------------------------------------------------------
| 曜 日 | ddd | Sun | dddd | Sunday | aaa |
------------------------------------------------------------
---------------------------------------------
| 種 類 | 表示例 | 記 号 | 表示例 |
---------------------------------------------
| 西 暦 ( 年 ) | | | |
| 和 暦 ( 元号 ) |平成 令和| | |
| 和 暦 ( 年 ) | | | |
---------------------------------------------
| 月 | Jul | mmmm | July |
| 日 | | | |
---------------------------------------------
| 曜 日 | 日 | aaaa | 日曜日 |
--------------------------------------------- ④ 日付データの操作(演算)の仕方 # 変数を日付型で宣言 Dim D_date, A_date As Date # 変数を長整数型で宣言 Dim abc As Long # 数値を日付型 ( yyyy/mm/dd )に変換 D_date = CDate(abc) # 年(A_dateの日付データ)を +1 (翌年)する。 D_date = DateAdd("yyyy", 1, A_date) # 月(A_dateの日付データ)を +1 (翌月)する。 D_date = DateAdd("m", 1, A_date) # 日(A_dateの日付データ)を -1 (前日)する。 D_date = DateAdd("d", -1, A_date)
上記のマクロを使用した、出勤台帳作成マクロ・作業日報_作成マクロを公開しています。 |
【 出勤台帳作成マクロをダウンロードする 】 | ( ダウンロード数: 1592 ) |
13. 関数を使い処理のスピードアップをする。 |
||
○ シート上で関数を使用して、プログラムの簡素化とスピードアップ図りましょう。 |
表 3.1 所 得 税 税 額 表 |
所得金額と扶養家族から、所得税を表検索するマクロを公開しています。 |
【 給与計算マクロ( 見本 )をダウンロードする 】 | ( ダウンロード数: 1835 ) | |
下記のダウンロードは、税額表から所得税を取得する部分のみのマクロです。 |
【 検索所得税マクロ( 見本 )をダウンロードする 】 | ( ダウンロード数: 1410 ) |
② 例 2 |
||
表 3.2 住 所 一 覧 表 |
||
郵便番号から、住所を表検索するマクロを公開しています。 |
【 検索住所マクロ( 見本 )をダウンロードする 】 | ( ダウンロード数: 1612 ) |