※ファイルサイズが大きいので保存不可(FTPでアップする：UTF8)

【ＶＢＡ－独自専用マニュアル】↓↓↓↓↓サーバーを変えたためか、記号(")(\)がエラーになるので直にアップすること ----------------------------------------------------------------------------------------------------------- 令和を表示するためのレジストリ HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Nls/Calendars/Japanese/Eras ”2019 05 01”=”令和_令_Reiwa_R” ※ システムでの年号表示を「和暦」に変えるといろいろな事が起きるのでしないように！ 日付と時刻の調整－地域－データ形式を変更する－カレンダー 西暦を和暦に（注意！） ----------------------------------------------------------------------------------------------------------- BASE64デコード／エンコード 参考：BASE64_Functions.bas (同フォルダに置いた) ----------------------------------------------------------------------------------------------------------- 外部でコピーしてあるものをペーストする Range("E1").PasteSpecial 'のみでOK ----------------------------------------------------------------------------------------------------------- 書式が勝手に「折り返して全体を表示する」に変更される事を回避する 「オプション」内の「データ範囲の形式および数式を拡張する」をチェックする ----------------------------------------------------------------------------------------------------------- VBA オートメーションエラー 回避策(参考) 「DoEvents」を使用すると回避できるかも →「Excel_De_楽天Ⅲ5」上では確定的な解決はみられなかった ----------------------------------------------------------------------------------------------------------- オートフィルターの設定状況 Sheets("sheet名").AutoFilter.FilterMode (～Excel2003) Sheets("sheet名").AutoFilterMode (Excel2007～) (true 又は false が返る) ----------------------------------------------------------------------------------------------------------- ・データの存在するセルの最終を求める(最下行) Cells(y,256).End(xlToleft).Column '選択行(y)の最終データ位置(桁目) Cells(65536,x).End(xlUp).Row '選択桁(x)の最終データ位置(行目) 注意※ x=65536 とした場合、65536は含まれない ・シートの開始データ位置 ActiveSheet.UsedRange.Column '最左列 ActiveSheet.UsedRange.Row '最上行 ※参考：シート上で使用されているセル域の最右列と最下行を求める Range("A1").SpecialCells(xlLastCell).Column '最左列(A1:固定) Range("A1").SpecialCells(xlLastCell).Row '最上行(A1:固定) ----------------------------------------------------------------------------------------------------------- ・以下 ***** の項は、VBAスピードアップと深い関わりがある ④については、アクティブシートの内容を更新する場合等には必須 ①大量データをアクティブシートに書込む場合は必須 ②と③を併用することで更に高速化が図れる -------------------------------------------------- ・例 Application.EnableEvents=False Application.ScreenUpdating=False Application.Cursor=xlWait Application.Calculation=xlManual (アクティブシートでの処理) Application.Calculation=xlAutomatic Application.Cursor=xlDefault Application.ScreenUpdating=True Application.EnableEvents=True *********************************************************************************************************** ①画面更新の停止と再会（表示スピード系／画面のチラツキをなくす) Application.ScreenUpdating=False '画面更新停止 Application.ScreenUpdating=True '画面更新再開 (注意)VBEデバッグの際、[False]に設定しているにも関わらずイメディエイト等で見ると[True]になっているので 注意すること *********************************************************************************************************** ②カーソルを「砂時計」に変換 Application.Cursor=xlWait '砂時計ON Application.Cursor=xlDefault '砂時計OFF *********************************************************************************************************** ③計算モード（高速化） Application.Calculation=xlManual '計算を手動モードにする Application.Calculation=xlAutomatic '計算を自動モードに戻す *********************************************************************************************************** ④イベント割込みの許可と不許可 Application.EnableEvents=False '割込ＮＧ ****↓↓**** Application.EnableEvents=True '割込ＯＫ ****↑↑**** ----------------------------------------------------------------------------------------------------------- ファイルオープン dim sN1 as long sN1=FreeFile:Open thisworkbook.path+"\test.dat" For Output As #sN1 close #sN1 ----------------------------------------------------------------------------------------------------------- レンジ表現使用の可不可　別タスクのコールの可不可など 　(可能なケース) 　・自シートから別シートをレンジ表現で操作 　　Sheets("sheet2").Range("A1:A10")="***" 　・モジュールからシートをレンジ表現で操作 　　Sheets("sheet2").Range("A1:A10")="***" 　・モジュールから別モジュールのタスクをコール←可能(Private sub,function では不可) 　(不可なケース) 　・シートから別シートのタスクをコール 　・モジュールからシートのタスクをコール ----------------------------------------------------------------------------------------------------------- ・ステータスバーへメッセージを表示 cntRec=cntRec+1 Application.StatusBar="処理実行中．．．．(現在 " & cntRec & "件)" ※途中で停止する場合の防止策 DoEvents:Application.StatusBar=cntRec ----------------------------------------------------------------------------------------------------------- ・絶対パスの参照 　1.現ワークブック　　ThisWorkBook.Path 　2.カレントフォルダ　curdir 　　C:\Documents and Settings\****\My Documents 　3.Win8で書込み可-1　Application.TemplatesPath 　　C:\Users\****\AppData\Roaming\Microsoft\Templates\ 　4.Win8で書込み可-2　Application.DefaultFilePath 　　C:\Users\****\Documents 　5.Win8で書込み可-3　Application.UserLibraryPath 　　C:\Users\****\AppData\Roaming\Microsoft\AddIns\ ※最終"\"の有る無しに注意 ----------------------------------------------------------------------------------------------------------- ・ウエイト(WAIT)動作 ・1/1000秒単位<API> 　(宣言)Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 　(使用)call Sleep(ミリ秒) 　(誤差)15Msec ・1秒単位 　Application.wait Now+TimeValue("00:00:01") '<--- ウエイト時間をセット 　(誤差)1sec ----------------------------------------------------------------------------------------------------------- ・特定シートのセルのデータを変数へ (1) w=Sheets("入力").Range("L8") (2) w=Worksheets("商品マスタ").Cells(1,9) ----------------------------------------------------------------------------------------------------------- ・特定シートの全クリアー 　 Worksheets("商品マスタ").cells.ClearContents ----------------------------------------------------------------------------------------------------------- ・特定シートへ切り替える 　 Sheets("納品書").Select ----------------------------------------------------------------------------------------------------------- ・特定シートの任意セルにカーソルを移動する 　 Sheets("納品書").Range("A2").Select 　 cells(5,3).select ----------------------------------------------------------------------------------------------------------- ・現セルの行・桁位置を変数へ dim sGYO as long '行 dim sKTA as long '桁 sGYO=ActiveCell.Row:sKTA=ActiveCell.Column ※ dim sGYO as long,sKTA as long:sGYO=ActiveCell.Row:sKTA=ActiveCell.Column ----------------------------------------------------------------------------------------------------------- ・割込み時のセル位置 　 target.Row '行 　 target.Column '桁 ----------------------------------------------------------------------------------------------------------- ・現在位置セルのデータ 　 ActiveCell.Value ----------------------------------------------------------------------------------------------------------- ・全セルを選択 　 ActiveSheet.Cells.Select ----------------------------------------------------------------------------------------------------------- ・値・数式クリア 　 Selection.ClearContents ----------------------------------------------------------------------------------------------------------- ・書式クリア 　 Selection.ClearFormats ----------------------------------------------------------------------------------------------------------- ・コメントクリア 　 Selection.ClearComments ----------------------------------------------------------------------------------------------------------- ・値・数式、書式、コメントを一緒にクリア 　 Selection.Clear ----------------------------------------------------------------------------------------------------------- ・シート全クリアー 　 Worksheets("シート名").Cells.ClearContents ----------------------------------------------------------------------------------------------------------- ・範囲指定でのセルをクリアー (1) Sheets("SHEET").Range("A1:A10").Value="" ○(2) Sheets("SHEET").Select:Range("A1:A10").Select:Selection.ClearContents (3) Worksheets("SHEET").Activate:worksheets("SHEET").Cells.ClearContents ※いつも苦労するので完全版:指定シート全消し〔ソース〕 　'================================================================================ 　 function cell_clear(sheet_name as string) 　'================================================================================ 　 dim cell_clear_wk as string 　 cell_clear_wk=ActiveSheet.Name '現シート名を保存 　 Application.ScreenUpdating=False '画面更新の停止(画面のチラツキをなくす) 　 Worksheets(sheet_name).Activate '指定シートに切換える 　 worksheets(sheet_name).Cells.ClearContents 　 Worksheets(cell_clear_wk).Activate '元のシートに戻す 　 Application.ScreenUpdating=True '画面更新の再開 　 end function ----------------------------------------------------------------------------------------------------------- ・リストボックス等を開く(閉じる) 　 UserForm1.Show (UserForm1.Hide) ----------------------------------------------------------------------------------------------------------- ・コマンドボタン表示を複数行にする 　 CommandButton1.Caption="コマンド"&Chr$(13)&"の検索" ----------------------------------------------------------------------------------------------------------- ・セルの文字サイズを変える 　 Range("A1").Font.Size=14 ----------------------------------------------------------------------------------------------------------- ・メッセージボックスの表示 (1) Okボタンのみ call MsgBox("完了しました",vbInformation,"確認ボックス") (2) Yes or No If MsgBox("処理して良いですか？",vbQuestion+vbYesNo+vbDefaultButton2,"確認ボックス")<>vbYes Then Exit Sub ※ボタンの種類 vbOKOnly (0) [OK]ボタンのみ vbOKCancel (1) [OK]・[キャンセル] vbAbortRetryIgnore (2) [中止]・[再試行]・[無視] vbYesNoCancel (3) [はい]・[いいえ]・[キャンセル] vbYesNo (4) [はい]・[いいえ] vbRetryCancel (5) [再試行]・[キャンセル] ※アイコンの表示 vbCritical (16) 警告メッセージ vbQuestion (32) 問い合わせメッセージ vbExclamation (48) 注意メッセージ vbInformation (64) 情報メッセージ ※標準ボタンの設定 vbDefaultButton1 (0) 第1ボタンが標準ボタン vbDefaultButton2 (256) 第2ボタンが標準ボタン vbDefaultButton3 (512) 第3ボタンが標準ボタン vbDefaultButton4 (768) 第4ボタンが標準ボタン ※その他 モーダルの設定 vbApplicationModal (vbSystemModal) ヘルプ ボタン追加 vbMsgBoxHelpButton 最前面のウィンドウとして表示 VbMsgBoxSetForeground テキストを右寄せ vbMsgBoxRight テキストを右から左の方向で表示 vbMsgBoxRtlReading ※リターン vbOK (1) [OK]ボタンが押された vbCancel (2) [キャンセル]ボタンが押された vbAbort (3) [中止]ボタンが押された vbRetry (4) [再試行]ボタンが押された vbIgnore (5) [無視]ボタンが押された vbYes (6) [はい]ボタンが押された vbNo (7) [いいえ]ボタンが押された (更に詳しく) http://vba-excel.seesaa.net/article/129485925.html (vb定数詳細) http://www.red.oit-net.jp/tatsuya/vb/fixed.htm ----------------------------------------------------------------------------------------------------------- ・ワークシート保護の状態をチェック 　 activesheet.ProtectContents=True '保護の場合 ----------------------------------------------------------------------------------------------------------- ・ワークブック保護設定 　 Activeworkbook.protect '(保護設定) 　 Activeworkbook.protect Password:="1234" '(保護設定：パスワード付き) 　 Activeworkbook.Unprotect '(保護解除) 　 Activeworkbook.Unprotect Password:="1234" '(保護解除：パスワード付き) ※ブック保護を使用する場合のプログラミングトラブル 例えば、Ａシートの指定範囲をコピーし、Ｂシートを再表示しＢシートの指定位置にペーストする 場合、Ｂシート再表示の直前でブック保護を解除する必要があるが指定形式ペーストの手順は × Ａシートの指定範囲をコピー → ○ ブック保護を解除 × ブック保護を解除 → ○ Ａシートの指定範囲をコピー × Ｂシートを再表示 → ○ Ｂシートを再表示 × Ｂシートの指定位置にペースト → ○ Ｂシートの指定位置にペースト ----------------------------------------------------------------------------------------------------------- ・カーソルの相対移動 　 ActiveCell.Offset( 2, 3).Activate '現セルから下へ2行＆右へ3列移動 　 ActiveCell.Offset(-1, 2).Activate '現セルから上へ1行＆右へ2列移動 　 ActiveCell.Offset( 5,-3).Activate '現セルから下へ5行＆左へ3列移動 　 ActiveCell.Offset(-4,-2).Activate '現セルから上へ2行＆左へ3列移動 　 ActiveCell.Offset(5).Activate '現セルから下へ5行移動 　 ActiveCell.Offset(,-2).Activate '現セルから左へ2列移動 　 ActiveCell.Offset(0, 1).Select '違う書き方 ----------------------------------------------------------------------------------------------------------- ・カーソルの絶対移動 　 Range("B4").Select 　 cells(2,3).Select ----------------------------------------------------------------------------------------------------------- ・外部プログラムを起動 Shell (パス名,[Windowスタイル]) [] は省略可 スタイル 1/5/9:フォーカスをもった通常のWindow 2 :フォーカスをもちアイコン化されているWindow 3 :フォーカスをもち最大表示されているWindow 4/8 :フォーカスを持たない通常のWindow 6/7 :フォーカスを持たないアイコン化されたWindow ----------------------------------------------------------------------------------------------------------- ・外部プログラムを起動－２（同期型） Dim wwww As object set wwww=CreateObject("WScript.Shell") wwww.Run "(コマンド記述)",(状態),(同期) (状態) (値=0) vbHide ウィンドウを非表示にします。 (値=1) vbNormalFocus 通常のウィンドウ、かつ最前面のウィンドウにします。 (値=2) vbMinimizedFocus 最小化、かつ最前面のウィンドウにします。 (値=3) vbMaximizedFocus 最大化、かつ最前面のウィンドウにします。 (値=4) vbNormalNoFocus 通常のウィンドウです。ただし、最前面にはなりません。 (値=6) vbMinimizedNoFocus 最小化します。ただし、最前面にはなりません。 (同期) true :同期する false:同期しない (記述例) ﾁｪｰﾝｽﾄｱ手書用より wwww.Run "cmd.exe /c copy /B "+ThisWorkBook.Path+"\print_out.txt "+chr(&h22)+"LPT1:"+chr(&h22),vbHide,true ----------------------------------------------------------------------------------------------------------- ・ファイルの削除 　 Kill "\temp3.bmp"　←フルパス ----------------------------------------------------------------------------------------------------------- ・スクリプトのキーボード割当て (public sub) Application.OnKey "{(key)}","xxx_pro" ← sub名 (key) ↑{UP} →{RIGHT} ↓{DOWN} ←{LEFT} BackSpace {BACKSPACE} or {BS} CapsLock {CAPSLOCK} Clear {CLEAR} ^Break {BREAK} Delete {DELETE} or {DEL} End {END} Enter {RETURN} Enter(ﾃﾝｷｰ) {ENTER} Esc {ESCAPE} or {ESC} F1-F15 {F1} - {F15} Help {HELP} Home {HOME} Ins {INSERT} NumLock {NUMLOCK} PageDown {PGDN} PageUp {PGUP} Return {RETURN} ScrollLock {SCROLLLOCK} Tab {TAB} (shift他) Shift + Ctrl ^ Alt % (使用例) ・次の使用例は、InsertProc を Ctrl + + キーに、SpecialPrintProc を Shift + Ctrl + →キーに登録します。 Application.OnKey "^{+}", "InsertProc" Application.OnKey "+^{RIGHT}", "SpecialPrintProc" ・次の使用例は、Shift + Ctrl + →キーを通常の機能に戻します。 Application.OnKey "+^{RIGHT}" ・解除の際の記述 Application.OnKey "+^{RIGHT}" ----------------------------------------------------------------------------------------------------------- ・現在の範囲指定に同じ文字を入れる 　 Range(Selection.Address)="1" ----------------------------------------------------------------------------------------------------------- ・現在のカーソル位置 activecell.row activecell.column ----------------------------------------------------------------------------------------------------------- ・<***１秒後に消え去るメッセージボックス***最小が１秒> 　 CreateObject("Wscript.Shell").popup "メッセージ",1,"タイトル" ----------------------------------------------------------------------------------------------------------- ・<API+SUB>設定時間後に消えるメッセージボックス　spbox(メッセージ,タイトル,ミリ秒) 　 Declare Function MessageBoxTimeoutA Lib "user32" ( _ 　 ByVal hWnd As Long, ByVal lpText As String _ 　 , ByVal lpCaption As String, ByVal uType As Long _ 　 , ByVal wLanguageId As Long, ByVal dwMilliseconds As Long _ 　 ) As Long 　 Function spbox(title As String,msg As String,t1000 As Long) 　 MessageBoxTimeoutA 0&, msg, title, vbMsgBoxSetForeground, 0, t1000 　 End Function ----------------------------------------------------------------------------------------------------------- ・ストリング変換(strconv)　w=strconv(w,<スイッチ>) <スイッチ> vbUpperCase ( 1) 文字列を大文字に変換 vbLowerCase ( 2) 文字列を小文字に変換 vbProperCase ( 3) 文字列の各単語の先頭の文字を大文字に変換します。 vbWide ( 4) 文字列内の半角文字を全角文字に変換 vbNarrow ( 8) 文字列内の全角文字を半角文字に変換 vbKatakana ( 16) 文字列内のひらがなをカタカナに変換 vbHiragana ( 32) 文字列内のカタカナをひらがなに変換 vbUnicode ( 64) システムの既定のコードページを使って文字列をUnicodeに変換 vbFromUnicode (128) 文字列をUnicodeからシステムの既定のコードページに変換 ----------------------------------------------------------------------------------------------------------- ・エクセルの強制終了手順 ①Application.DisplayAlerts=False これを直前に設定すれば保存ボックスは開かない ②Application.Quit これだけなら普通の終了（直前に保存ボックスが開く） ③ActiveWorkbook.Close ブックを強制的に閉じる（①②だけならVBAエラーになる場合があるため必要） ----------------------------------------------------------------------------------------------------------- ・エクセルの上書き保存(強制) 　 ThisWorkbook.Save ----------------------------------------------------------------------------------------------------------- ・保護シートをＶＢＡから操作可能にする 　 Worksheets("入力").Protect UserInterfaceOnly:=True ----------------------------------------------------------------------------------------------------------- ・範囲指定の位置を取得 1.行位置 開始行 = Selection.Row 終了行 = 開始行 + Selection.Rows.Count - 1 2.列位置 開始列 = Selection.Column 終了列 = 開始列 + Selection.Column.Count - 1 ----------------------------------------------------------------------------------------------------------- ・セル単位でのロック(保護)操作 　 Cells(y,x).Locked=False 'ロック解除 　 Cells(y,x).Locked=True 'ロック設定 ----------------------------------------------------------------------------------------------------------- ・範囲名の削除法 [挿入]-[名前]-[定義]で削除 ----------------------------------------------------------------------------------------------------------- ・エラーなどで死んでしまった割込み機能を復活させる 　 Application.EnableEvents=True ----------------------------------------------------------------------------------------------------------- ・現在のアクティブブック名を得る ファイル名=Application.ThisWorkbook.Name (例) Book1 ----------------------------------------------------------------------------------------------------------- ・現在のアクティブシート名を得る ActiveSheet.Name (例) 入力シート ----------------------------------------------------------------------------------------------------------- ・エクセルがインストールされているフォルダ名(DIR) 　 Application.Path (例) C:\Program Files\Microsoft Office\OFFICE11 ----------------------------------------------------------------------------------------------------------- ・コンピュータのユーザー名の取得:Object.UserName〔ソース〕 (例) 　 Dim PcUserName As String 　 Dim WshNetworkObject As IWshRuntimeLibrary.WshNetwork 　 Set WshNetworkObject=New IWshRuntimeLibrary.WshNetwork 　 PcUserName=WshNetworkObject.UserName ※「Windows Script Host Object Model」を参照設定しておく ----------------------------------------------------------------------------------------------------------- ・<API+SUB>コンピュータ名の取得〔ソース〕 　 Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long 　' 　 Function GetMyComputerName() As String 　 Dim strCmptrNameBuff As String*21 　 GetComputerName strCmptrNameBuff,Len(strCmptrNameBuff) 　 GetMyComputerName=Left$(strCmptrNameBuff,InStr(strCmptrNameBuff,vbNullChar)-1) 　 End Function ----------------------------------------------------------------------------------------------------------- ・行/列の非表示と再表示 　 Rows("4:5").EntireRow.Hidden=True '行の非表示 　 Rows(10).Hidden=True '行の非表示 　 Rows("3:6").EntireRow.Hidden=False '行の再表示 　 Columns("E:F").EntireColumn.Hidden=True '列の非表示 　 Columns(6).Hidden=True '列の非表示 　 Columns("D:G").EntireColumn.Hidden=False '列の再表示 ----------------------------------------------------------------------------------------------------------- ・ファイルのコピー 　 FileCopy "c:\test.dat","c:\aaa\test.dat" ----------------------------------------------------------------------------------------------------------- ・ＶＢＡのオプション 　1.Option Explicit :宣言していない変数があればコンパイルエラーになる 　2.Option Base {0|1} :配列の先頭を(0)にするか(1)にするかの宣言(Init=0) 　　　　　　　　　　　　　　　　 なんでもないように見えるが 「for each ～」を使用する際などには必要 　3.Option Private Module :特に使用しない(×) 　4.Option Compare {Binary|Text}:文字列の大小を比較する際に変化する(Init=Binary) ----------------------------------------------------------------------------------------------------------- ・[Ctrl]+[セルクリック]でセル間データを入換える処理(各シートイベントで必要) 　'============================================================ 　 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 　'============================================================ 　 Dim gsub_Rng As Range 　 Dim gsub_M as variant 　 If Selection.Count<>2 Then Exit Sub 　 gsub_M=ActiveCell.Value 　 For Each gsub_Rng In Selection 　 If gsub_Rng.Address<>ActiveCell.Address Then ActiveCell.Value=gsub_Rng.Value:gsub_Rng.Value=gsub_M 　 Next gsub_Rng 　 End Sub ----------------------------------------------------------------------------------------------------------- ・<API>キーコードの読み取り　GetAsyncKeyState(キーコード) 　 Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long ----------------------------------------------------------------------------------------------------------- ・<API>ビープ音　Beep(周波数,ミリ秒) 　 Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long,ByVal dwDuration As Long) As Long ※この処理を使用する場合は、通常の「Beep命令」は使用できない ----------------------------------------------------------------------------------------------------------- ・画面スクロール 　 ActiveWindow.LargeScroll Down:=1,ToRight:=2,Up:=(-1),ToLeft:=(-2) '画面単位 　 ActiveWindow.SmallScroll Down:=1,ToRight:=2,Up:=(-1),ToLeft:=(-2) '行単位 ※セルG9が左上にくるようにワークシートをスクロール 　 With ActiveWindow 　 .ScrollRow=9 　 .ScrollColumn=7 　 End With ----------------------------------------------------------------------------------------------------------- ・セル内部の計算式を書き換える 　 Cells(1,1).Formula="=B2+666" 　 Cells(1,1).Formula="=" & chr(34) & "ABC" & chr(34) & "&" & chr(34) & "DEF" & chr(34) '<--- chr(34)=ﾀﾞﾌﾞﾙｸｫｰﾄ ----------------------------------------------------------------------------------------------------------- ・セル内部の計算式を取込む 　 Dim w As String 　 w=Cells(1,1).Formula ※書式を文字列に変更すれば、セルにも出せる 　 Cells(1,10).NumberFormatLocal="@" 　 Cells(i,10)=Cells(1,1).Formula ----------------------------------------------------------------------------------------------------------- ・スクロール範囲の設定 　 ActiveSheet.ScrollArea="$A$1:$L$30" 　 Worksheets("入力").ScrollArea="$A$1:$L$30" 　 Worksheets("入力").ScrollArea="" 'スクロール範囲の設定を解除 ----------------------------------------------------------------------------------------------------------- ・ファイル名・フォルダ名のリネーム 　 Name "C:\data" As "C:\new_data" ----------------------------------------------------------------------------------------------------------- ・フォルダの作成 　 mkdir "フルパスのフォルダ名" ----------------------------------------------------------------------------------------------------------- ・フォルダの削除 　 RmDir (フルパスのフォルダ名) ※内部にファイルが存在する場合、エラーになる ----------------------------------------------------------------------------------------------------------- ・エラー情報の消去 　 err.clear ----------------------------------------------------------------------------------------------------------- ・チェンジ割込みイベント　先頭での処置 　 if Target.Address<>"$M$9" then exit sub '単一セルで判断 　 If Intersect(Target, Range("M9:M108")) Is Nothing Then Exit Sub '範囲で判断 ----------------------------------------------------------------------------------------------------------- ・シートを非表示／再表示 　 Worksheets("Sheet").Visible=xlHidden '非表示 　 Worksheets("Sheet").Visible=xlSheetVisible '再表示 ----------------------------------------------------------------------------------------------------------- ・<Enter>でのカーソルの移動方向を変える 　 Application.MoveAfterReturnDirection=xldown 　 xlToLeft(左方向)　xlToRight(右方向)　xlUp(上方向)　xlDown(下方向) ----------------------------------------------------------------------------------------------------------- ・左端/上端の行列番号のフォントを変更するダイアログの表示 　 Application.Dialogs(xlDialogFont).Show を実行 ----------------------------------------------------------------------------------------------------------- ・ユーザーフォームの [X] を非表示にする 「タイムカード集計」init_word.bas 参照 ----------------------------------------------------------------------------------------------------------- ・行を「表示しない」に設定 　 rows("4:999").EntireRow.Hidden=true　(false で「表示する」) 　 rows("6").EntireRow.Hidden=true　(6行目を表示しない) ----------------------------------------------------------------------------------------------------------- ・エクセルシートの左肩の絶対座標 　 Activewindow.PointsToScreenPixelsX(0) '座標(X) 　 Activewindow.PointsToScreenPixelsY(0) '座標(Y) ----------------------------------------------------------------------------------------------------------- ・セルの位置ほか 　 cells(1,1).Top 　 cells(1,1).Left 　 cells(1,1).Width 　 cells(1,1).Height ----------------------------------------------------------------------------------------------------------- ・cells 使用の範囲指定方法 　 Range(Cells(1,1),Cells(100,100)).Value=1 など ----------------------------------------------------------------------------------------------------------- ・Shell関数による「電卓」や「メモ帳」の起動 　 Sub test() 　 Dim ReturnValue 　 ReturnValue = Shell("CALC.EXE",1) '*** アプリケーション名 (1=windowstyle) *** 　 AppActivate ReturnValue 　 End Sub 電卓 : CALC.EXE メモ帳 : NOTEPAD.EXE ※windowstyle(省略時[2]に設定される) 0:(vbHide) フォーカス有りで非表示 1:(vbNormalFocus) フォーカス有りで元のサイズと位置に復元 ← 使い良い 2:(vbMinimizedFocus) フォーカス有りで最小化表示 3:(vbMaximizedFocus) フォーカス有りで最大化表示 4:(vbNormalNoFocus) フォーカス無しで最後に閉じたときのサイズと位置に復元 6:(vbMinimizedNoFocus) フォーカス無しで最小化表示 ※停止方法 SendKeys "%{F4}",True ----------------------------------------------------------------------------------------------------------- ・ツールバーの ON/OFF Application.CommandBars("**ツールバーの名称**").Visible=True '表示(ON) Application.CommandBars("**ツールバーの名称**").Visible=False '非表示(OFF) ・ツールバーの名称 標準 "Standard" 書式設定 "Formatting" [ウォッチ]ウィンドウ 不明 3-Dの設定 "3-D Settings" Visual Basic "Visual Basic" Web "Web" グラフ "Chart" グラフメニューバー "Chart Menu Bar" コントロールツールボックス "Control Toolbox" チェック/コメント "Reviewing" デザインモードの終了 "Exit Design Mode" ビボットテーブル "PivotTable" フォーム "Forms" リスト 不明 ワークシートメニューバー "Worksheet Menu Bar" ワークシート分析 "Auditing" ワードアート "WordArt" 影の設定 "Shadow Settings" 外部データ "External Data" 記録終了 "Stop Recording" 罫線 不明 循環参照 "Circular Reference" 図 "Picture" 図形描画 "Drawing" 図表 不明 全画面表示 "Full Screen" 組織図 不明 読み上げ 不明 描画キャンバス 不明 並べて比較 不明 保護 不明 クリップボード "Clipboard" ----------------------------------------------------------------------------------------------------------- ・WINDOWS(OS)の名前とバージョン 　 Application.OperatingSystem ----------------------------------------------------------------------------------------------------------- ・エクセルバージョンの取得 　 Application.Version 15=(2013) 14=(2010) 12.0=(2007) 11.0=(2003) 10.0=(2002) 9.0=(2000) ----------------------------------------------------------------------------------------------------------- ・アクティブシートのみを「xls」出力 　 ActiveWorkBook.SaveAs Filename:="****.xls" 　 ActiveWorkBook.Close (?) ----------------------------------------------------------------------------------------------------------- ・シートの表示/非表示設定 　 Worksheets("シート名").Visible=xlSheetVisible '表示 　 Worksheets("シート名").Visible=xlHidden '非表示 ----------------------------------------------------------------------------------------------------------- ・メールの送信(システム標準メーラー起動)　※１バイト系、空白と＆を変換する必要が 　 Sub mail_send_test() 　 Dim sAddr As String 　 Dim sBody As String 　 Dim sSubj As String 　 Dim sComd As String 　 sAddr="dts@sec123.com" 　 sSubj="これは件名" 　 sBody="ここから本文"+"%0D%0A"+ _ 　 "改行は、[0D] [0A] "+"%0D%0A"+ _ 　 "以上"+"%0D%0A"+ "%0D%0A" 　 sComd="Mailto:" & sAddr & "?Subject=" & sSubj & "&body=" & sBody 　 CreateObject("WScript.Shell").Run sComd 　 End Sub ----------------------------------------------------------------------------------------------------------- ・範囲名(名前)の設定を変更(入力規則使用時によく使う) activeworkbook.names("範囲名").refersto="=シート!$A$1:$A$100" '[$] 必要 ----------------------------------------------------------------------------------------------------------- ・固体番号の取得 (2003/2007/2010) Sub test001() dim w_Service as object dim w_items as object dim w_obj as object Const w_fix=&H30 Set w_Service=GetObject("winmgmts:\\.\root\CIMV2") Set w_items =w_Service.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct","WQL",w_fix) For Each w_obj In w_items Debug.Print "IdentifyingNumber: " & trim(w_obj.IdentifyingNumber) Debug.Print "Name: " & trim(w_obj.Name) Debug.Print "UUID: " & trim(w_obj.UUID) Debug.Print "Vendor: " & trim(w_obj.Vendor) Debug.Print "Version: " & trim(w_obj.Version) Next End Sub '(実行結果) ' IdentifyingNumber: YK8B123456 ' Name: PRIMERGY ' UUID: F4493637-AD39-DE11-A847-0019995C63E8 <--- 2007:all[F] ' Vendor: FUJITSU-SV ' Version: GS01 確実な固体番号としては、上の５データを連結すれば良い ----------------------------------------------------------------------------------------------------------- ・保護のプロパティ (ﾁｪｯｸ=True) [初期値] [False] AllowFormattingCells セルの書式設定 [False] AllowFormattingColumns 列の書式設定 [False] AllowFormattingRows 行の書式設定 [False] AllowInsertingColumns 列の挿入 [False] AllowInsertingRows 行の挿入 [False] AllowInsertingHyperlinks ハイパーリンクの挿入 [False] AllowDeletingColumns 列の削除 [False] AllowDeletingRows 行の削除 [False] AllowSorting 並べ替え [False] AllowFiltering オートフィルタの使用 [False] AllowUsingPivotTables ピボットテーブル レポートを使用する [True] Contents オブジェクトの編集(逆) [True] Scenarios シナリオの編集(逆) [False] DrawingObjects 描画オブジェクトの編集 [False] UserInterfaceOnly VBAマクロからの変更 (例) Worksheets("sheet1").Protect UserInterfaceOnly:=True,Password:="abc123" Worksheets("sheet1").EnableSelection=xlUnlockedCells '保護されたセルは選択不可にする 1.xlNoSelection ：すべてのセルを選択禁止 2.xlUnlockedCells ：保護されたセルは選択不可にする 3.xlNoRestrictions ：どのセルの選択も可能 ----------------------------------------------------------------------------------------------------------- ・文字色を設定(ColorIndex 使用) Range("A1").Font.ColorIndex = 1 cells(10,10).Font.ColorIndex = 1 (1:黒　2:白　3:赤　4:明るい緑　5:青　6:明るい黄色　7:マゼンタ　8:シアン　9:茶　10:緑　11:紺　12:うぐいす) ----------------------------------------------------------------------------------------------------------- ・文字色を設定(Color 使用) Range("A1").Font.Color = &HFFF Range("A1").Font.Color = RGB(0,255,0) (Color=16進数またはRGB関数の戻り値) ----------------------------------------------------------------------------------------------------------- ・セル色を設定(ColorIndex 使用) Cells(1,1).Interior.ColorIndex=0 ----------------------------------------------------------------------------------------------------------- ・参考資料　マクロをマクロで削除する方法 マクロ削除を手動で削除するのでなくて、マクロをマクロで削除する方法を以下に示します。 前条件 1. Microsoft Visual Basic Application Extensibility の参照設定が必要 （VBEのウィンドウメニューのツール(T)の参照設定(R)から）。 2. EXCEL2003のマクロセキュリティの設定で『Visual Basic プロジェクトへのアクセスの信頼する』をチェックする （Excelウィンドウのツール(T)->マクロ->セキュリティ(S)->信頼できる発行元タグの一番下）。 ※自らを含めてモジュールが全て消去される〔ソース〕 Dim objVBCOMPO As Object For Each objVBCOMPO In ActiveWorkbook.VBProject.VBComponents With objVBCOMPO.CodeModule If .CountOfLines <> 0 Then .DeleteLines 1, .CountOfLines End With If (objVBCOMPO.Type = vbext_ct_StdModule Or objVBCOMPO.Type = vbext_ct_MSForm) Then ActiveWorkbook.VBProject.VBComponents.Remove objVBCOMPO End If Next objVBCOMPO Set objVBCOMPO = Nothing ※空の標準モジュールが削除されない場合がある（原因は不明） ----------------------------------------------------------------------------------------------------------- ・参考資料　マクロから(VBA/VBE)を操作する 〔外部ファイル内ソースモジュールをインポート〕 With ActiveWorkbook.VBProject .VBComponents.Remove .VBComponents("Module12") End With Workbooks("Book2.xls").VBProject.VBComponents.Import Filename 〔テストOKの処理－川井〕 With ActiveWorkbook.VBProject .VBComponents.Remove .VBComponents("TEST2") End With ＞自モジュールの"TEST2"が消去された ActiveWorkbook.VBProject.VBComponents.Import "TEST.bas" ＞"TEST" というモジュールが生成された。( TEST.bas は、カレントフォルダに存在) ＞既に、"TEST"というモジュールが存在する場合は、"TEST1"→"TEST2" と番号が自動付与される ＞[Microsoft Visual Basic Application Extensibility] の参照設定は不必要だった ＞上記により、外部ファイルからの [モジュール] の入換えは可能になる ＞[フォーム] をエクスポートすれば [*.frm] と [*.frx] の２ファイルが生成される、 ＞インポートする際のファイル名は [*.frm] のみで良い ＞[クラス] は、[*.cls] ＞シートに保護を掛けてこの処理を行うとエラーになる(VBA操作可で保護を掛けるとＯＫ) ＞※注意※ [k茶] で蓋を掛けるとエラーになる ＞※注意※ VBA保護を掛けるとエラーになる 〔シート・モジュール単位でエクスポート〕使う必要あるのか？？？？？ Dim VBC With ActiveWorkbook.VBProject For Each VBC In .VBComponents If VBC.Type = 1 And _ VBC.CodeModule.CountOfDeclarationLines <> VBC.CodeModule.CountOfLines Then VBC.Export "C:\temp\" & VBC.Name & ".bas" End If Next VBC End With ' VBC.Type : 100=シート　1=モジュール ' VBC.CodeModule.CountOfDeclarationLines : ? ' VBC.CodeModule.CountOfLines Then : 行数 ----------------------------------------------------------------------------------------------------------- ・参考資料　ByRef と ByVal の区別（デフォルトは、ByRef になっている） ByRef : 参照渡し : 呼び出し先で変数の変更があれば、自プロシジャ内でも変更されている（影響を受ける） ByVal : 値渡し : 呼び出し先で変数の変更があっても、自プロシジャ内では変更されていない（影響を受けない） ※引数を保持する場合は、「ByVal」 ※複数の引数に加工を加えた結果が欲しい場合は、「ByRef」の必要がある ※デフォルトは、「ByRef」になっている ----------------------------------------------------------------------------------------------------------- ・フォルダ選択ダイアログ〔ソース〕 sub test() Dim xlAPP As Application Set xlAPP=Application ' InputBoxでフォルダ指定を受ける strPATHNAME=xlAPP.InputBox("参照するフォルダ名を入力して下さい。",cnsTITLE,"C:\") ' ① If StrConv(w,vbUpperCase)="FALSE" Then Exit Sub end sub ----------------------------------------------------------------------------------------------------------- ・指定セルの内容の判別方法:数式/数値/文字列〔ソース〕 if Range("A1").HasFormula then debug.print "数式です" else if IsNumeric(Range("A1").Value) then debug.print "数値です" else debug.print "文字列です" end if end if ----------------------------------------------------------------------------------------------------------- ・全シート名のリスト〔ソース〕 Dim ws As Worksheet For Each ws In Worksheets Cells(ws.Index,1)=ws.Name Next ----------------------------------------------------------------------------------------------------------- ・メニューバーの ON/OFF　一覧表示〔ソース〕 Application.CommandBars("Worksheet Menu Bar").Enabled=true '(false=off) ※当処理は、エクセルに対する設定なので一度設定を変更すると反映され続けるので処理の終わりには「もとに戻す」配慮が必要です。 ----------------------------------------------------------------------------------------------------------- ・ツールバーの ON/OFF Application.CommandBars("ツールバー名称[Standardなど]").Visible=True '(false=off) Sub GetCommandbarInfo() Dim AppCmdBar As CommandBar Dim i As Integer i = 0 For Each AppCmdBar In Application.CommandBars i = i + 1 Sheet1.Cells(i,1)=AppCmdBar.Index 'インデックス番号の取得 Sheet1.Cells(i,2)=AppCmdBar.Name 'コマンドバーの名前の取得 Sheet1.Cells(i,4)=AppCmdBar.Visible 'コマンドバーのON/OFF Select Case AppCmdBar.Type 'コマンドバーの種類の取得 Case 0 Sheet1.Cells(i,3)="ツールバー" Case 1 Sheet1.Cells(i,3)="メニューバー" Case 2 Sheet1.Cells(i,3)="ポップアップ" End Select Next AppCmdBar End Sub ※現在のコマンドバーの(ON/OFF)状態は、同じく (.Visible=True/false) で判断できる。 ※当処理は、エクセルに対する設定なので一度設定を変更すると反映され続けるので処理の終わりには「もとに戻す」配慮が必要です。 ----------------------------------------------------------------------------------------------------------- ・ショートカットメニューバー ON/OFF Application.CommandBars("ショートカットメニューバー名称").Enabled=True '(false=off) ※当処理は、エクセルに対する設定なので一度設定を変更すると反映され続けるので処理の終わりには「もとに戻す」配慮が必要です。 ----------------------------------------------------------------------------------------------------------- ・Application.Volatile とは Function 内に使用する(シート関数として使用できる) ＞ユーザー定義関数を自動再計算関数にする ＞"ture" は省略可能 ＞Volatileメソッドを入れない標準状態だと「自動で再計算を行わない」関数になる ＞例　Function Test() As Variant 　　　　 Application.Volatile 　　　　 Test="Volatile TEST" 　　　　End Function ----------------------------------------------------------------------------------------------------------- ・[Excel] 関数(特記事項)　=EOMONTH(開始日,月) 開始日から、指定した月数だけ前または後の月末の日付を得る (Exp.) =EOMONTH("2011/10/1",2) <--- 2011年12月 の末日が得られる =EOMONTH("2011/10/1",0) <--- 2011年10月 の末日が得られる ----------------------------------------------------------------------------------------------------------- ・[VBA] 月末 DateSerial(Year(Date),Month(Date)+0,0) '前月の月末日 DateSerial(Year(Date),Month(Date)+1,0) '今月の月末日 DateSerial(Year(Date),Month(Date)+2,0) '翌月の月末日 ----------------------------------------------------------------------------------------------------------- ・参考資料　クラスモジュールの存在意義 1.クラスモジュールでプログラム構造を定義しておけば「再帰的処理」のような使用方法が 　　可能になる。 　　例えば、少し内容が違うだけで複数の似た処理を作らなければならない際に効果がある、 　　フラグ処理等、後に処理内容が解らなくなるのを防ぐことができる？？ 2.クラスモジュールを使用して変数・処理をオブジェクト化することにより[VBE]を使用して 　　標準モジュールを組み立てゆく際、オブジェクト名が次々に表示されるため、 　　効率的にソースプログラムを組み立てられる。 　　※この機能は、他エディターでソースを編集する人（筆者）には余り効果はない。 ----------------------------------------------------------------------------------------------------------- ・指定文字のみを全変換 Replace(文字列,指定文字列,変更後の文字列) ----------------------------------------------------------------------------------------------------------- ・ON ERROR GOTO ～ 情報の消去 Clearメソッドを使用する 【機能】 オブジェクトに関連付けられている説明の文字列を含む文字列式を設定します。値の取得も可能です。 【書式】 Err.Clear 【 例 】 If Err.Number<>0 Then Debug.Print Err.Number Debug.Print Err.Source Debug.Print Err.Description Err.Clear 'エラー情報のクリア End If ※ 次のいずれかのステートメントが実行されると、Clear メソッドが自動的に呼び出されます。 ・Resume ステートメント ・Exit Sub、Exit Function、Exit Property ステートメント ・On Error ステートメント ※ 次のステートメントが実行されると、エラーを無視し処理が続く ・On Error Resume Next ・On Error goto 0 で解除することができる ----------------------------------------------------------------------------------------------------------- ・指定範囲の罫線のみペーストする Selection.PasteSpecial Paste:=xlPasteFormats,Operation:=xlNone,SkipBlanks:=False,Transpose:=False ----------------------------------------------------------------------------------------------------------- ・シートパスワードの解除操作 [^A] → [^C] → [Shift]+[F11] → [^V] ----------------------------------------------------------------------------------------------------------- ・文字列をバイト単位で使用する方法 データ(Dat)をバイト単位で扱えるように変換する--->Dat2 Dat2=StrConv(Dat,vbFromUnicode) Dat2では、バイト関数が使用できる lenb・rightb・leftb・midb・など セル等にセットする場合は、戻す必要がある cells(10,15)=strconv(midb(Dat2,1,3),vbUnicode) ----------------------------------------------------------------------------------------------------------- ・ズーム表示の制御 ActiveWindow.Zoom=200 '200%に設定する ----------------------------------------------------------------------------------------------------------- ・cells表現(y,x)のレンジアドレスを得る wW=cells(10,10).address ' "$J$10" ---> wW ・レンジ表現("$J$10")のセルアドレスを得る sY=range("$R$10").Row ' 10 ---> sY sX=range("$R$10").Column ' 18 ---> sX ----------------------------------------------------------------------------------------------------------- シリアル値を得る DateSerial("2007","12","01") Date　現在の日付を得る(シリアル値) DateValue("2008/9/2")　2008/9/2のシリアル値を得る DateAdd　myDate=DateAdd("m",1,DateValue("2008/9/2")) 日付の足し算をする（シリアル値で計算） mを指定することにより、1ヶ月足され、2008/10/2の値を得られる。年はy、日はdを指定する Datedif("2007/8/1","2007/12/3","M")　"2007/12/3"と"2007/8/1"の期間を月（"M"）で表示する ここでは3(ヶ月)という値が返ってくる "M"を変更すれば他の値が返る "Y"･･･年数 "M"･･･月数 "D"･･･日数 Time　現在の時刻を得る(シリアル値)。 TimeValue("17:00:00")　17:00:00のシリアル値を得る ----------------------------------------------------------------------------------------------------------- 単独でシリアル値のみを得る 　 wDATA=str(timer) ----------------------------------------------------------------------------------------------------------- 西暦→和暦 Format$("2002/1/10","GGGEE年MM月DD日") '平成14年01月10日 和暦→西暦 Format$("平成14年01月10日","YYYY/MM/DD") '2002/01/10 ----------------------------------------------------------------------------------------------------------- セルへのデータ転送の限界 1.セル同士の転送　910文字（テストは、911個の「新」をcells(2,1)にセットして行った） cells(1,1)=cells(2,1) など 2.変数→セルへの転送　65509文字（テストは、65509個の「新」をwWにセットして行った） cells(1,1)=wW など ----------------------------------------------------------------------------------------------------------- エクセル独自のアラートメッセージ(エラー)を出さなくする 　 Application.DisplayAlerts=False　(処理後 True に戻す事) ----------------------------------------------------------------------------------------------------------- 保護セルをダブルクリック禁止にする 　 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 　 If Target.Locked Then Cancel=True 　 End Sub ----------------------------------------------------------------------------------------------------------- エクセルアラートの回避手段 「変更しようとしているセルまたはグラフは保護されているため読み取り専用となっています。・・・変更するには・・・」 ・このメッセージは保護セルをダブルクリックした際に出る、しかも「Application.DisplayAlerts=False」が効かない (対策)割込み処理内でエラー処理をした後、(Exit sub 実行前に)現在のセル位置をどこでも良いから変更すると出ない。 又は、前記「保護セルをダブルクリック禁止にする」でも可能 ----------------------------------------------------------------------------------------------------------- プリンタ制御 　 ActiveSheet.PageSetup.PrintArea="$F$7:$P$53" '印刷範囲の設定 　 ActiveWindow.SelectedSheets.PrintPreview '①プリントプレビュー画面 　 ActiveWindow.SelectedSheets.PrintOut '②プレビュー無しで、直プリント 　 ActiveSheet.PageSetup.PrintArea="" '印刷範囲をクリアー 　 ActiveSheet.DisplayPageBreaks=False '印刷範囲の点線をクリアー ----------------------------------------------------------------------------------------------------------- 入力規則　プルダウンメニューの幅について 　メニューの幅が広いものに自動設定される場合の対処方法 　・入力規則が設定されていないセルに移動した後に保存する ----------------------------------------------------------------------------------------------------------- ファイルの存在をチェック 　Dir("c:\TEST.xls") 'ファイルが存在：ファイル名　存在しない："" ----------------------------------------------------------------------------------------------------------- ファイル一覧を得る 　 Sub test() 　 Dim wNAME As String 　 wNAME=Dir("C:\Downloads\*.*") '<--- ワイルドカード可 　 Do While wNAME<>"" 　 Debug.Print wNAME '<--- ここで処理 　 wNAME=Dir() '<--- 次のデータを得る 　 Loop 　 end Sub ※ Dir("C:\Downloads\*.*",vbDirectory) とすると、フォルダも得る事ができる ----------------------------------------------------------------------------------------------------------- フォームの起動と消去　 Form.Show　Form.Hide　Load Form　Unload Form　の違い ・Load (Form名) 'メモリ上にあり、画面非表示 ・(Form名).Show 'メモリ上にあり、画面表示 ・(Form名).Hide 'メモリ上にあり、画面非表示 ・Unload (Form名) 'メモリから削除、画面非表示 ----------------------------------------------------------------------------------------------------------- シート関数の使用方法 　 sCNT=Application.WorksheetFunction.SUM(Worksheets(1).Range("A1:A10")) ↑ ----------------------------------------------------------------------------------------------------------- コード変換(ファイル単位)　Shift_JIS ---> EUC/UTF-8/UTF-16/Unicode 　 function SJIS_ENC(wFNAME as string) 'wFNAMEはフルパスでのファィル名(同ファィルを変換する処理になる) 　 dim sN1 as long 　 dim wREC as string 　 Dim outObj As Object 　 Set outObj=CreateObject("ADODB.Stream") 　 outObj.Type=2 '2:テキスト 1:バイナリ 　 outObj.Charset="euc-jp" 'ほか "UTF-8" "Unicode" "UTF-16" 　 '原本のコードは何でも良い 　 outObj.LineSeparator=10 '区切り文字(改行)を指定(例では、LF) 　 '-1:CRLF 10:LF 13:CR 　 outObj.Open 　 sN1=FreeFile:Open wFNAME For input As #sN1 　 do until eof(sN1) 　 line input #sN1,wREC 　 outObj.WriteText wREC,1 '上記で指定した区切り文字を使用する場合は、"1" が必要 　 loop 　 Close #sN1 　 outObj.SaveToFile (wFNAME),2 '2:上書き 　 outObj.Close 　 Set outObj=Nothing 　 End function ----------------------------------------------------------------------------------------------------------- コード変換コード変換(ファイル単位)　UTF-8 ---> Shift-Jis 　 function UTF8_SJIS(wI_NAME as string,wO_NAME as string) 'wI_NAME/wO_NAME はフルパスで設定 　 Dim wREC As String 　'UTF-8を読み込む 　 With CreateObject("ADODB.Stream") 　 .Charset="UTF-8" 　 .Open 　 .LoadFromFile wI_NAME 　 wREC=.ReadText 　 .Close 　 End With 　'テキストファイルで書き出す(普通にShift-JISになる) 　 With CreateObject("Scripting.FileSystemObject").CreateTextFile(wO_NAME,True) 　 .write wREC 　 .Close 　 End With 　 End function ----------------------------------------------------------------------------------------------------------- コード変換コード変換(文字列単位) SJIS <---> UTF8 　 function TO_UTF8(xWORD as string) as string 'SJIS ---> UTF8 　 With CreateObject("ScriptControl") 　 .Language="JScript" 　 TO_UTF8 =.CodeObject.encodeURI(xWORD) 　 End With 　 End Function 　 function TO_SJIS(xWORD as string) as string 'UTF8 ---> SJIS　うまく動かない(2015/04/18) 　 With CreateObject("ScriptControl") 　 .Language= "JScript" 　 TO_SJIS =.CodeObject.decodeURI(xWORD) 　 End With 　 End Function ----------------------------------------------------------------------------------------------------------- データフォーマット変換 　 Format(データ,変換形式) (Exp.)Format(date,"ggge年m月d日") ---> 平成25年6月6日 ----------------------------------------------------------------------------------------------------------- ファイルの全読込み（１つの変数にまるごとセットする）〔ソース〕 　 Option Explicit 　'========================================================================================== 　 Function ALL_READ(xPATH as string,xFNAME as string) as string 'ファイルの全読込み 　'========================================================================================== 　 Dim OBJ_FILE As Object 　 Dim OBJ_TEXT As Object 　 Dim wOPEN As String 　 Set OBJ_FILE=CreateObject("Scripting.FileSystemObject") 　 wOPEN=OBJ_FILE.BuildPath(xPATH,xFNAME) 　 Set OBJ_TEXT = OBJ_FILE.OpenTextFile(wOPEN, 1) 　 ALL_READ="" 　 If OBJ_TEXT.AtEndOfStream=False Then ALL_READ=OBJ_TEXT.ReadAll 　 OBJ_TEXT.Close 　 Set OBJ_TEXT=Nothing 　 Set OBJ_FILE=Nothing 　 End function ----------------------------------------------------------------------------------------------------------- 参照設定をコントロール〔ソース〕 1.参照設定があれば外す 　 Dim ref As Variant 　 With ActiveWorkbook.VBProject 　 For Each ref In ActiveWorkbook.VBProject.references 　 If ref.Description="(プロジェクト名)" Then .references.Remove ref 　 Next ref 　 End With '(プロジェクト名)：プロパティ－プロジェクトの説明の項で設定されたもの 2.参照設定に設定 　 Application.VBE.activevbproject.references.AddFromFile (ファイル名：フルパス) ----------------------------------------------------------------------------------------------------------- ★情報() 01　データ件数を得るFSOの問題点 　　データ件数は以下のFSOで得ることができる 　　データ件数=CreateObject("Scripting.FileSystemObject").openTextFile(フルパス名,8).Line-1 　　しかし、区切りが[0A]のみのデータも１件とみなされるためエクセルのテキスト処理には使えない 02　64ビット版の問題点 　　Declare Function ---> Declare PtrSafe Function 　　Declare Sub ---> Declare PtrSafe Sub 　　※その他、変数宣言などの書き方が違う場合がある 　　※注意　「office2010/2013」を64ビット版でインストールしたものについては互換が無いと判断した方が良い 03　Excel2010/2013など、初期処理にてVBAで自動保護を掛けた直後セルカーソルが消失する場合がある 　　対策として、最初に表示したいシート以外のシートに一度切り替えた後に戻すと解消する 04　Excel2010/2013など、保護を掛けたシートでダブルクリック割込みを使用する場合、 　　入力規則を設定しているセル(ロック無し)をダブルクリックした場合、無視されることの対処方、 　　保護時のオプション(DrawingObjects:=False)を設定すると解消する ----------------------------------------------------------------------------------------------------------- 書式設定：右に少しだけ隙間を空ける方法 　1. "0_!" 　2. "0_ " 　3. "0_1"　　　1→3順に隙間が大きくなる ----------------------------------------------------------------------------------------------------------- Sendkeys　キー入力を自動化する 　SendKeys "ABC" A→B→Cとキー入力 　SendKeys "{ENTER}" Enterキー入力 　SendKeys "{F2}" [F2]キー入力 　SendKeys "+(AB)" Shiftキーを押しながらA→Bと入力 　SendKeys "%{F4}" Alt+[F4]キーを入力 　SendKeys "{UP 5}" ↑キーを５回入力 　SendKeys "{A 10}" Aを10回入力 Sendkeys　キーコード 　BackSpace {BACKSPACE} Delete {DELETE} 　Insert {INSERT} CapsLock {CAPSLOCK} 　Enter {ENTER} Esc {ESCAPE} 　NumLock {NUMLOCK} PageDown {PGDN} 　PageUp {PGUP} Tab {TAB} 　F1～F15 {F1}～{F15} 　→ {RIGHT} ← {LEFT} ↑ {UP} ↓ {DOWN} 　Ctrl ^ 　Alt % 　Shift + 　SendKeys "+;" スペースの入力 ----------------------------------------------------------------------------------------------------------- 定数（Const）宣言 　 Const (定数名) as (変数型) = (データ) (例) 　 Public Const A as string = "AAA" 　 Private Const B as long = 65536 　 Const Alph as string = "abcdefghijklmnopqrstuvwzyzABCDEFGHIJKLMNOPQRSTUVWZYZ" ----------------------------------------------------------------------------------------------------------- １行・１列のデータを全て削除 　 rows(n).clearcontents 　 Column(n).clearcontents ----------------------------------------------------------------------------------------------------------- クリップボードへの入出力（参照：Microsoft Forms 2.0 Object Library） 　 dim wW As String 　 dim CB As New DataObject 　'〔変数からクリップボードへ格納〕 　 CB.SetText wW 'wW のデータをオブジェクト変数に格納 　 CB.PutInClipboard 'クリップボードに格納 　'〔クリップボードから変数へ取得〕 　 CB.GetFromClipboard 'クリップボードからデータを取得 　 wW=CB.GetText 'オブジェクト変数から wW に取得 　【注意】クリップボードが空の場合「～FORMATETC 構造体が無効～」のエラーになるので 　 If CB.GetFormat(1) Then ～ '←で回避する ----------------------------------------------------------------------------------------------------------- クリップボード画像をファイル出力 　自ソース(少し改造しただけ) API_SAVE_CB.bas(API) を探せ 　(使い方) 　リターン変数(Boolean)=SaveClipToJpg(クリップボードのオブジェクト変数,保存ファイル名:フルパス) 　リターン変数が [True:成功] [False:失敗] ※参考※ 　Excel内の画像(シェイプ等)を直接ファイル出力する機能は無いのでクリップボードを経由して行う 　 Dim oZUKEI As Shape 　 For Each oZUKEI in ActiveSheet.Shapes 　 ～NEXT　必要画像を選択する処理など 　(選択した画像のみの場合はこう) 　 wNAME=Selection.Name 　 SaveClipToJpg(ActiveSheet.shapes(wNAME),保存ファイル名) 　プロパティ参考 　 oZUKEI.name:名前 oZUKEI.width:幅 oZUKEI.height:高さ 　 oZUKEI.top:オフセット上 oZUKEI.left:オフセット左 oZUKEI.Rotation:角度 ----------------------------------------------------------------------------------------------------------- 右クリック禁止　①シート毎 　 Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object,ByVal Target As Range,Cancel As Boolean) 　 Cancel=True 　 End Sub ----------------------------------------------------------------------------------------------------------- 右クリック禁止　②ブック全体 　 CommandBars("Cell").Enabled=False '(or True) (注意)Book Open 時など、シートが開いていない場合は、VBAエラーになる場合がある ----------------------------------------------------------------------------------------------------------- ドラック＆ドロップ機能の禁止　表構造の人為的破壊を防ぐ 　 Application.CellDragAndDrop=False '(or True) ----------------------------------------------------------------------------------------------------------- 切り取りを禁止 　 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 　 If Application.CutCopyMode=2 Then Application.CutCopyMode=0 　 End Sub ----------------------------------------------------------------------------------------------------------- 数式バーの制御 　 Application.DisplayFormulaBar=True '表示(false:非表示) ----------------------------------------------------------------------------------------------------------- 配列変数の再定義 　 dim myData() as string 　(...処理...) 　 ReDim myData(2) As Integer '型を変えることもできる 　※内容を保持したまま再定義する場合 　 ReDim Preserve myData(sI) ----------------------------------------------------------------------------------------------------------- 初期化(Erase・クリアー・消去) ・配列変数の初期化 　 dim wTBL(1000) as string 　 Erase wTBL 'これだけで初期化される ・配列変数の初期化２ 　 dim wTBL() as string 　 ReDim wTBL(1000) as string 　 Erase wTBL '初期化されるが[ReDim]での再定義値も初期化されるので注意(解放される) ----------------------------------------------------------------------------------------------------------- ボタンの表示・非表示（オンオフ） ・コマンドボタン(ActiveX)←Windows Update で問題を起こしたオブジェクト(巨大化,未動作など) 　Worksheets("Sheet1").ボタン名.Visible=False '非表示(True:表示) ・フォームボタン 　Worksheets("Sheet1").Shapes.range("ボタン名").Visible=False '非表示(True:表示) ----------------------------------------------------------------------------------------------------------- 列表記を数値にする(例:CC列を数値にする) 　range("CC1").Column '1などを付けないとエラーになるので ----------------------------------------------------------------------------------------------------------- IE制御：ボタンを押す(Submit) 　( 宣言 )　dim objIE As Object:Set objIE=CreateObject("InternetExplorer.application") 　(方法_1)　objIE.document.getElementByID("submitButton").Click 　(方法_2)　objIE.Document.getElementsByName("Submit").Item(0).Click 　(方法_3)　objIE.Document.Forms(0).Submit 　※以前から、(方法_3)で行ってきたが2016年3月から楽天の更新ボタンが押せなくなったため(方法_1)に変えた 　※変数(objIE)はグローバル変数にしておくと便利 　　PUBLIC objIE As Object ----------------------------------------------------------------------------------------------------------- ページからのリターンソース 　wRET=objIE.Document.body.innerHTML ----------------------------------------------------------------------------------------------------------- IE制御：項目のセット 　( 宣言 )　dim objIE As Object:Set objIE=CreateObject("InternetExplorer.application") 　(方法_1)　objIE.Document.getElementsByName("入力項目").Item(0).value="ABC123" 　　　　　　(HTML) 　　　　　　<input name="入力項目" type="text" size="8" maxlength="6" value=""> 　(方法_2)　objIE.document.all.xxUSER-ID.Value="0123456" ----------------------------------------------------------------------------------------------------------- IE制御：IE_ビジーからの返りを待つ 　While objIE.Busy Or objIE.ReadyState<>4 　Wend ----------------------------------------------------------------------------------------------------------- IE制御：チェックボックスをチェックする 　objIE.Document.getElementsByName("名称")(1).click '3つ並びの場合は、(0)→(1)→(2) ----------------------------------------------------------------------------------------------------------- 名前付きセルの名前を知る 　cells(2,23).name.name ※名前付きセルでない場合はエラーになる ----------------------------------------------------------------------------------------------------------- 外部ブックの制御① 　 On Error Resume Next '開いてない場合、次の処理がエラーになるため 　 Workbooks("a.xlsm").save '既に開いていた場合の措置 　 Workbooks("a.xlsm").close '↑ 　 Workbooks.Open thisworkbook.path & "\..\a.xlsm" 'フルパス指定 　 Workbooks("a.xlsm").Activate 'アクティブにする 　 On Error goto 0 'エラー割込み解除 ----------------------------------------------------------------------------------------------------------- 書式設定：セル単位で「0」の場合だけ表示しない 　「ユーザー定義」にて　#;-#;"";@ ----------------------------------------------------------------------------------------------------------- Excel2013　リボンのオンオフ 　 Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" 'オフ 　 Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)" 'オン ----------------------------------------------------------------------------------------------------------- 最大化・最小化ほか 　 Dim window1 As Window 　 Set window1=Windows(1) 　 window1.WindowState=xlNormal '通常表示 　 window1.WindowState=xlMaximized '最大化表示 　 window1.WindowState=xlMinimized '最小化表示 ----------------------------------------------------------------------------------------------------------- 曜日の取得 　 s=weekday(シリアル値) 　※s=1(日)2(月)3(火)4(水)5(木)6(金)7(土) ----------------------------------------------------------------------------------------------------------- 範囲のコピーとペーストを同時に実行する簡単な書き方 　 Range("A1:Z1").Copy Range("A10") ----------------------------------------------------------------------------------------------------------- オートフィルタを解除 　 If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 　※オートフィルタ無しの場合はエラーになるため ----------------------------------------------------------------------------------------------------------- 行・列の表示/非表示 　 Columns(2).Hidden =True '(列の非表示/True:表示) 　 Columns("B").Hidden=True 　 Rows(2).Hidden =True '(行の非表示/True:表示) ----------------------------------------------------------------------------------------------------------- 改ページプリビューのセット 　 Set ActiveSheet.HPageBreaks(5).Location = Range("A151") 　 上の例は、シートの5個目の改ページ位置は150-151間になるということ (exp.) 　 for sI=2 to 199:Set ActiveSheet.HPageBreaks(sI).Location = Range("A" & trim(sI*50+1)):next ----------------------------------------------------------------------------------------------------------- 改ページプリビューのセット：その２ 　 ActiveSheet.Rows(42).PageBreak=xlPageBreakManual 　 上の例は、改ページポイントを41-42間に入れるいうこと ----------------------------------------------------------------------------------------------------------- 強制的に再計算を実行 　 Application.Calculate ----------------------------------------------------------------------------------------------------------- セル範囲内の成分数を求める 　 WorksheetFunction.CountA(range("J18:P18")) 　 WorksheetFunction.CountA(range(cells(14,10),cells(14,16))) ※結果がゼロの場合は「空」という事 ----------------------------------------------------------------------------------------------------------- ドラッグ・アンド・ドロップ編集をできないようにする 　Application.CellDragAndDrop=False ----------------------------------------------------------------------------------------------------------- Excel2013にて　VBAでの印刷プリビュー時に画面が黒くなるのを防ぐ方法 　 DoEvents '←プリビュー直前にいれると防げる 　 Activeworkbook.PrintPreview 　 ... ----------------------------------------------------------------------------------------------------------- 図形の非表示/表示 　 ActiveSheet.Shapes("BOX").visible=false/true ----------------------------------------------------------------------------------------------------------- 条件付コンパイル：OSのバージョン・Excelのバージョン等で[Declear文]の書き方が違う場合に使用する 　行先頭に「#」が入る ----------↓↓↓↓↓使用例 Option Explicit 'メール送信API(BASP21)SEC 実験ロジック(自動メール受信)付き '↓↓↓OS種による切換え(不要行をコメントに) #Const Windows7_OS_Bit=64 'OSが64Bitの場合、"c:\BSMTP.dll"と指定する。[BSMTP.dll] > [C:\]へセット '''''#Const Windows7_OS_Bit=32 'OSが32Bitの場合、"BSMTP.dll"で良い。[BSMTP.dll] > [..\system32\]へセット #If Windows7_OS_Bit=64 Then Declare Function SendMail Lib "c:\BSMTP.dll" (szServer As String, szTo As String, szFrom As String, szSubject As String, szBody As String, szFile As String) As String Declare Function RcvMail Lib "c:\BSMTP.dll" (szServer As String, szUser As String, szPass As String, szCommand As String, szDir As String) As Variant Declare Function ReadMail Lib "c:\BSMTP.dll" (szFILE As String,szPARA As String,szDIR As String) As Variant #Else Declare Function SendMail Lib "BSMTP.dll" (szServer As String, szTo As String, szFrom As String, szSubject As String, szBody As String, szFile As String) As String Declare Function RcvMail Lib "BSMTP.dll" (szServer As String, szUser As String, szPass As String, szCommand As String, szDir As String) As Variant Declare Function ReadMail Lib "BSMTP.dll" (szFILE As String,szPARA As String,szDIR As String) As Variant #End If ----------↑↑↑↑↑ (参考URL)http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_500.html =========================================================================================================== 書式：少数以下がなければ少数以下を表示しない 　#,##0.##　小数点以下の数字が存在する場合のみ最大2桁が表示され整数部はカンマ区切り 　[.]は付加されるので注意 =========================================================================================================== クリッブボードを空にする (exp.) 　 Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long 　 Public Declare Function CloseClipboard Lib "user32" () As Long 　 Public Declare Function EmptyClipboard Lib "user32" () As Long 　 function TEST() 　 OpenClipboard (0&) 　 EmptyClipboard 　 CloseClipboard 　 End function =========================================================================================================== 配列をセルに一発でセット：高速化に有効 　 Sub test() 　 Dim a(2,2) As Variant 　 a(0,0)="A":a(0,1)="B":a(0,2)="C" 　 a(1,0)="D":a(1,1)="E":a(1,2)="F" 　 a(2,0)="G":a(2,1)="H":a(2,2)="I" 　 Range("a1:c3")=a '配列量が一致しない場合　指定範囲が少：該当配列のみセット 　 ' 配列が少：該当配列以外はエラー表示になる 　 End Sub =========================================================================================================== マウスからの座標データ 　 Private Type POINTAPI 　 x As Long,y As Long 　 End Type 　'マウスカーソルの位置を取得するAPI 　 Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 　'----------------------------------- 　 Sub M_TEST() 　 Dim p As POINTAPI 'API用変数 　 GetCursorPos p 'カーソル位置取得 　 Range("V30")=p.x 'x座標 　 Range("V31")=p.y 'y座標 　 End Sub =========================================================================================================== セルの座標　単位(ポイント)　１ポイント＝1/72インチ 　Selection.top 'ポイント：セル範囲の上端からの距離 　Selection.left 'ポイント：セル範囲の左端からの距離 　Selection.width 'ポイント 　Selection.height 'ポイント(ピクセル) 　※ピクセル：標準フォントの半角文字での文字数 =========================================================================================================== 選択した範囲(Range)の左上セルと右下セルの位置を求める 　 Dim wRANGE As Range 　 Set wRANGE=Selection 　 wY1=wRANGE.Cells(1).Row '左上セル(行) 　 wX1=wRANGE.Cells(1).Column ' ↑ (列) 　 wY2=wRANGE.Cells(wRANGE.Count).Row '右下セル(行) 　 wX2=wRANGE.Cells(wRANGE.Count).Column ' ↑ (列) =========================================================================================================== セル位置アドレスのアルファベットを求める 　Split(ActiveCell.Address,"$")(1) '<--- アルファベット(列)のみ 　Split(ActiveCell.Address,"$")(2) '<--- 数値(行)のみ =========================================================================================================== ファイルの更新日時を求める 　FileDateTime("c:\Bootlog.txt") 　フォーマット→"YYYY/MM/DD HH:MM:SS" (exp.)"2018/02/03 13:33:03" =========================================================================================================== 文字列を区切り文字指定で自動配列生成する 　対象文字列　TXT　←"AA,BB,CC,DD,EE,FF,GG"　区切り文字="," 　Dim wBUF() As String 　wBUF=split(TXT",",") '配列変数wBUFが自動生成される 　sC =UBound(wBUF)+1 '配列数(1～x) =========================================================================================================== ★特記事項(不可解な動作・エラーなど) 01　入力シートの「保護」について 　　画像貼付機能を使用する場合は、保護のチェック「オブジェクトの編集」がオフなら[1004エラー]になる 02　フォームのキャプション設定 　　複数フォームを使用の場合、UserForm.Caption値が同じなら実行時エラーになる 　　☆この現象は、分かりにくいので特に注意 　　※「UserForm.Caption値」とは、ユーザーフォームの先頭部のタイトル表示内のテキストのことです 　　　即ち、同じタイトル名は使えないのだ =========================================================================================================== USBメモリを刺し装置ををダブルクリックすると、「アプリケーションが見つかりません」となる事の解決 　http://renkadehazuki.blog134.fc2.com/blog-entry-21.html =========================================================================================================== ExcelでCSVファイルを読み込んだ際、12桁以上の数値が浮動少数に変換される事を回避する 　(例) 123456789012 → 1.23457E+11 〔Excel-2003〕 0. 空白のブックでExcelを開く 1. [データ]－[外部データの取り込み]－[データの取り込み] 2. ファイルを選択する 3. テキストファイルウィザードが表示される 4. (1/3) 特に変更しなくて良い －[次へ] 5. (2/3) 区切り文字と文字列の引用符を設定する －[次へ] 6. (3/3) 重要 　　　　 ・データのプレビューにて必要なら全ての列を選択する(Shift使用可) 　　　　 ・列のデータ形式を文字列にする 　　　　 ・－[完了] 　　　　 ※[詳細]ボタンでの設定は不要 7. データの先頭位置を選択する(通常は、"A1"です) 8. 終了 〔Excel-2013〕 0. 空白のブックでExcelを開く 1. [データ]－[外部データの取り込み]－[テキストファイル] --- 以降は〔Excel-2003〕と同様 --- =========================================================================================================== Excel互換モードでの実行かどうかを判断：Excel2013にて[xxx.xls]を互換モードで実行した際、行と列の最大値が 　　　　　　　　　　　　　　　　　　　 違うためVBAエラーになることを回避(for next Max値/既定の指定範囲など) 　ActiveWorkbook.Excel8CompatibilityMode=true '互換モードで実行 false:通常実行 　(exp.) 　 sVERSION=int(Application.Version) '12=Excel2007(2007は最大値がアップしているが問題ありなので下位Ver.とする) 　 'アップ行数(1048576)は特に必要無いなら2016でも使用しない 　 if sVERSION>12 then 　 if ActiveWorkbook.Excel8CompatibilityMode then 　 gsMAX_KTA=256 　 activeworkbook.names("既定範囲").refersto="=Main!$E$11:$E$65536" '範囲指定を旧設定に 　 else 　 gsMAX_KTA=16384 　' (予め[既定範囲]はアップ行数の最大値で設定しているとする) 　 end if 　 else 　 gsMAX_KTA=256 　 activeworkbook.names("既定範囲").refersto="=Main!$E$11:$E$65536" '範囲指定を旧設定に 　 end if =========================================================================================================== テキスト変換 　wW=StrConv("abcなど",vb引数) 　vbUpperCase (1):大文字に変換します 　vbLowerCase (2):小文字に変換します 　vbProperCase (3):各単語の先頭の文字を大文字に変換します 　vbWide (4):半角文字を全角文字に変換します 　vbNarrow (8):全角文字を半角文字に変換します 　vbKatakana (16):ひらがなをカタカナに変換します 　vbHiragana (32):カタカナをひらがなに変換します 　vbUnicode (64):システムの既定のコードページを使ってを[Unicode]に変換します 　vbFromUnicode(128):[Unicode]からシステムの既定のコードページに変換します =========================================================================================================== 【END POINT (最終更新日:2019/05/11) 】↑↑↑↑↑