ブログ一覧

関数組み込み関数から対数を求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'関数組み込み関数から対数を求める

Function LogN(x, n) As Double
'**********************************************
'組み込み関数から対数を求める
'**********************************************
LogN = Log(x) / Log(n)
End Function

関数組み込み関数から三角関数-双曲線-サイン-コサイン-タンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'関数組み込み関数から三角関数-双曲線-サイン-コサイン-タンジェントを求める
'HSinHCosHTan

Function HSin(x) As Double
'**********************************************
'双曲線サイン Hyperbola-Sine を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
HSin = (Exp(x) - Exp(-x)) / 2
End Function

Function HCos(x) As Double
'**********************************************
'双曲線コサイン Hyperbola-Cosine を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
HCos = (Exp(x) + Exp(-x)) / 2
End Function

Function HTan(x) As Double
'**********************************************
'双曲線タンジェント Hyperbola-Tangent を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
HTan = (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))
End Function

Private Sub test1()
Debug.Print 4 * HTan(1)
End Sub

関数組み込み関数から三角関数-双曲線-セカント-コセカン-コタンジェンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'関数組み込み関数から三角関数-双曲線-セカント-コセカン-コタンジェンを求める
'HSecHCosecHCotan

Function HSec(x) As Double
'*****************************************************
'双曲線セカント Hyperbola-Secant を求める
'*****************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HSec = 2 / (Exp(x) + Exp(-x))
End Function

Function HCosec(x) As Double
'*****************************************************
'双曲線コセカント Hyperbola-Cosecant を求める
'*****************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HCosec = 2 / (Exp(x) - Exp(-x))
End Function

Function HCotan(x) As Double
'*****************************************************
'双曲線コタンジェント Hyperbola-Cotangent を求める
'*****************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HCotan = (Exp(x) + Exp(-x)) / (Exp(x) - Exp(-x))
End Function

Private Sub test1()
Debug.Print 4 * HCotan(1)
End Sub

関数組み込み関数から三角関数-双曲線アーク-セカント-コセカン-コタンジェンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'関数組み込み関数から三角関数-双曲線アーク-セカント-コセカン-コタンジェンを求める
'HArcsecHArccosecHArccotan

Function HArcsec(x) As Double
'**************************************************************
'双曲線アークセカント Hyperbola-Arc-Secant を求める
'**************************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArcsec = Log((Sqr(-x * x + 1) + 1) / x)
End Function

Function HArccosec(x) As Double
'**************************************************************
'双曲線アークコセカント Hyperbola-Arc-Cosecant を求める
'**************************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArccosec = Log((Sgn(x) * Sqr(x * x + 1) + 1) / x)
End Function

Function HArccotan(x) As Double
'**************************************************************
'双曲線アークコタンジェント Hyperbola-Arc-Cotangent を求める
'**************************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArccotan = Log((x + 1) / (x - 1)) / 2
End Function

関数組み込み関数から三角関数-セカント-コセカント-コタンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'組み込み関数から三角関数-セカント-コセカント-コタンジェントを求める
'SecCosecCotan
Function Sec(x) As Double
'*********************************
'セカント Secant を求める
'*********************************
'三角関数 Trigonometric Function
'返値はラジアン
Sec = 1 / Cos(x)
End Function

Function Cosec(x) As Double
'*********************************
'コセカント Cosecant を求める
'*********************************
'三角関数 Trigonometric Function
'返値はラジアン
Cosec = 1 / Sin(x)
End Function

Function Cotan(x) As Double
'*********************************
'コタンジェント Cotangent を求める
'*********************************
'三角関数 Trigonometric Function
'返値はラジアン
Cotan = 1 / Tan(x)
End Function

関数組み込み関数から三角関数-双曲線アーク-サイン-コサイン-タンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'関数組み込み関数から三角関数-双曲線アーク-サイン-コサイン-タンジェントを求める
'HArcsinHArccosHArctan

Function HArcsin(x) As Double
'********************************************************
'双曲線アークサイン Hyperbola-Arc-Sine を求める
'********************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArcsin = Log(x + Sqr(x * x + 1))
End Function

Function HArccos(x) As Double
'********************************************************
'双曲線アークコサイン Hyperbola-Arc-Cosine を求める
'********************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArccos = Log(x + Sqr(x * x - 1))
End Function

Function HArctan(x) As Double
'********************************************************
'双曲線アークタンジェント Hyperbola-Arc-Tangent を求める
'********************************************************
'三角関数 Trigonometric Function
'返値はラジアン
HArctan = Log((1 + x) / (1 - x)) / 2
End Function

関数数値表示書式指定文字の使用例Format関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'(VB:Help)
'
'指定した書式 (format)  正の数 5     負の数 5        小数 .5    Null 値
'長さ 0 の文字列 ("")      5           -5              0.5
'0                         5           -5              1
'0.00                      5.00        -5.00           0.50
'#,##0                     5           -5              1
'#,##0.00;;;Nil            5.00        -5.00           0.50       Nil
'\\#,##0;\\-#,##0         \5          (\5)            \1
'\\#,##0.00;\\-#,##0.00   \5.00       (\5.00)         \0.50
'0%                        500%        -500%             50%
'0.00%                     500.00%     -500.00%       50.00%
'0.00E+00                  5.00E+00    -5.00E+00       5.00E-01
'0.00E-00                  5.00E00     -5.00E00        5.00E-01
'
'数値表示書式指定文字 (Format 関数)
'
'(0)
'桁位置や桁数を指定するときに使います。引数 format に指定した書式文字列内の表示書式指定文字
'"0" 1 つで、数値の 1 桁を表します。変換対象の数値 (式) が、"0" で指定された桁位置を使ってい
'る場合は､その桁に該当する値が入ります｡変換対象の数値の桁数が少なく､指定された桁位置に該
'当する値がない場合は、その桁には 0 が入ります。
'引数 expression に指定した数値の整数部または小数部の桁数が、指定書式内の "0" の桁位置に満
'たない場合は、その桁位置には 0 が付加されます。また、数値の小数部の桁数が小数部に指定した
'"0" の桁位置を超える場合には、数値の小数部は指定の桁位置に合わせて四捨五入されます。逆に、
'整数部の桁数が整数部に指定した "0" の桁位置を超える場合には、整数部は変更されることなく、
'すべて表示されます｡
'
'(#)
'桁位置や桁数を指定するときに使います。引数 format に指定した書式文字列内の表示書式指定文字
' "#" 1 つで、数値の 1 桁を表します。変換対象の数値 (expression) が "#" で指定された桁位置
'を使っている場合は､その桁に該当する値が入ります｡変換対象の数値の桁数が少なく､指定された
'桁位置に該当する値がない場合は､その桁には何も入りません｡
'この記号は表示書式指定文字の "0" と同じような働きをしますが、数値の小数部や整数部の桁数が
'"#" で指定された桁位置に満たない場合に 0 は挿入されず、その桁には何も入りません。
'
'(.)
'表示書式指定文字 ("0" または "#") と組み合わせて、小数点の位置を指定するときに使います。
'表示する桁数を指定するとき､この表示書式指定文字の位置によって､整数部と小数部が区別されま
'す。指定書式内で "." の左側に "#" だけが指定されている場合は、1 未満の数値は小数点記号から
'始まります。数値が 1 未満の場合に小数点記号の左側に常に 0 が付くようにするには、指定書式内
'で " " の左側に "#" ではなく "0" を指定します。変換後の小数点記号は、オペレーティングシス
'テムの国別情報の設定によって決まります｡
'
'(%)
'数値を 100 倍し、パーセント記号 (%) を付けるときに指定します。
'
'(,)
'1000 単位の区切り記号を挿入するときに指定します。整数部が 4 桁以上ある数値については、1000
'単位の区切り記号が付きます。変換後の 1000 単位の区切り記号は、オペレーティングシステムの国
'別情報の設定によって決まります。通常、この表示書式指定文字 "," の前後に "0" または "#" を指
'定して使います。この表示書式指定文字 "," の右側に "0" も "#" も指定しない場合、つまり、整数
'部の右端にこの表示書式指定文字 "," を 1 つ、または 2 つ以上続けて指定した場合 (小数部の表示
'指定の有無は任意)、変換対象の数値は 1000 単位で割った値に変換されます。このとき、値は桁位置
'の指定に応じて丸められます。たとえば、書式指定文字列として "##0,," と指定すると、
'数値 100000000 (1 億) は、100 に変換されます。100 万未満の数値は 0 となります。整数部の右端
'以外でこの表示書式指定文字 "," を 2 つ以上続けて指定した場合は、"," を 1 つ指定したときと同
'じになります｡
'
'(:)
'時刻の区切り記号を挿入するときに指定します｡時刻を時間､分､秒で区切ることができます｡
'変換後の時刻の区切り記号は､オペレーティングシステムの国別情報の設定によって決まります｡
'
'(/)
'日付の区切り記号を挿入するときに指定します｡日付を年､月､日で区切ることができます｡
'変換後の区切り記号は､オペレーティングシステムの国別情報の設定によって決まります｡
'
'(E- E+ e- e+)
'指数表記で表すときに指定します。"E-"、"E+"、"e-"、"e+" のいずれかの右側に "0" または "#" を
' 1 つ以上指定すると、数値は指数表記で表され、整数部と指数部の間に e または E が挿入されます。
'これらの表示書式指定文字の右側に指定する "0" または "#" の数は、指数部の桁数を示します。"E-"
'や "e-" を使うと、指数が負の場合にはマイナス記号が付きます。"E+" や "e+" の場合は、
'指数の正負に合わせてプラス記号かマイナス記号が付きます｡
'
'- + $ ( ) スペース
'指定する文字をそのまま挿入します｡これら以外の表示書式指定文字を挿入するには､
'その前に円記号 (\) を付けるか、ダブルクォーテーション (" ") で囲みます。
'
'(\)
'すぐ後に続く 1 文字をそのまま表示します。書式指定の中で、特別な意味を持っている "#" または
' "E" などの文字を文字としてそのまま表示するには、その文字の前に円記号 (\) を付けます。
'この場合、前に付けた円記号 (\) は表示されません。文字をダブルクォーテーション (" ")
'で囲んでも、同じです。円記号 (\) を挿入するには、円記号 (\) を 2 つ続けて記述します (\\)。
'そのままでは挿入できない文字としては､
'日付や時刻の表示書式指定文字 (a、c、d、h、m、n、p、q、s、t、w、y、/、:)、
'数値の表示書式指定文字 (#、0、%、E、e、カンマ、ピリオド)、
'文字列の表示書式指定文字 (@、&、<、>、 ) などがあります。
'
'("ABC")
'ダブルクォーテーション (" ") で囲まれた文字列は、そのまま挿入されます。
'書式指定の引数 format に文字列を含めるには、Chr(34) を使って文字列を囲みます。
'文字コードではダブルクォーテーション (" ") は 34 になります。

関数指定したファイルの作成日を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FileDate(PathName As String) As String
'********************************
'指定したファイルの作成日を返す
'********************************
'返り値はString型
'日付だけを"yyyy/mm/dd"形式で返す
'エラー時は"yyyy/mm/dd"を返す

Dim GetDate As String
On Error GoTo MyERR:
GetDate = FileDateTime(PathName)

FileDate = Format(GetDate, "yyyy/mm/dd")

Exit Function

MyERR:

FileDate = "yyyy/mm/dd"

'FileDateTime 関数
'指定したファイルの作成日時または最後に修正した日時を示す値を返す
'
'構文
'
'FileDateTime (pathname)
'
'引数 pathname は必ず指定します。
'引数 pathname には、ファイル名を示す文字列式を指定します。
'フォルダ名およびドライブ名を含めて指定できます｡

End Function

Private Sub test()
MsgBox FileDate(ThisWorkbook.Path & "\" & ThisWorkbook.Name)
End Sub

関数組み込み関数から三角関数-アーク-サイン-コサイン-タンジェントを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'関数組み込み関数から三角関数-アーク-サイン-コサイン-タンジェントを求める
'ArcsinArccosArctangent

Function Arcsin(x) As Double
'***************************************
'アークサイン Arc-Sine を求める
'***************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arcsin = Atn(x / Sqr(-x * x + 1))
End Function

Function Arccos(x) As Double
'***************************************
'アークコサイン Arc-Cosine を求める
'***************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function

Function Arctan(x) As Double
'***************************************
'アークタンジェント Arc-Tangent を求める
'***************************************
'三角関数 Trigonometric Function
'返値はラジアン
'※アークタンジェントはVB関数に存在します。
Arctan = Atn(x)
End Function

Private Sub test1()
Debug.Print 4 * Arctan(1)
'3.14159265358979
End Sub

Atn 関数

指定した数値のアークタンジェントを倍精度浮動小数点数型 (Double) で返します。
構文
Atn (Number)
引数 number は必ず指定します。
引数 number には、倍精度浮動小数点数型 (Double) の数値または任意の数式を指定します。
解説
Atn 関数は、直角三角形の 2 辺の比を引数 (number) として受け取り、対応する角度を返します。
ここでいう 2 辺とは、直角をはさむ 2 つの辺を指します。
2 辺の比は、求める角の反対側の辺 (対辺) の長さをもう一方の辺 (底辺、つまり求める角に隣接する側の辺) の長さで割った値です。
戻り値は、-π/2 ～π/2 の範囲の値 (単位はラジアン) になります。
角度の単位を度からラジアンに変換するには、度にπ/180 を掛けます。
ラジアンから度に変換するには､ラジアンに 180 / πを掛けます｡
メモ Atn 関数は Tan 関数の逆三角関数です。
Tan 関数は、引数として角度を受け取り、その角度を含む直角三角形の直角をはさむ2辺の比を返します。
Atn 関数と、タンジェントの逆数であるコタンジェント (1/タンジェント) の違いに気を付けてください。

関数組み込み関数から三角関数-アーク-セカント-コセカン-コタンジェンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'関数組み込み関数から三角関数-アーク-セカント-コセカン-コタンジェンを求める
'ArcsecArccosecArccotan

Function Arcsec(x) As Double
'**********************************************
'アークセカント Arc-Secant を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arcsec = Atn(x / Sqr(x * x - 1)) + Sgn((x) - 1) * (2 * Atn(1))
End Function

Function Arccosec(x) As Double
'**********************************************
'アークコセカント Arc-Cosecant を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arccosec = Atn(x / Sqr(x * x - 1)) + (Sgn(x) - 1) * (2 * Atn(1))
End Function

Function Arccotan(x) As Double
'**********************************************
'アークコタンジェント Arc-Cotangent を求める
'**********************************************
'三角関数 Trigonometric Function
'返値はラジアン
Arccotan = Atn(x) + 2 * Atn(1)
End Function

Private Sub test1()
Debug.Print 4 * Arccotan(1)
End Sub

関数四捨五入・切上げ・切捨てVBandVBA

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub RoundingOff()
'**********************************
'四捨五入・切上げ・切捨てVBandVBA
'**********************************

Dim dblPlus(1) As Double
Dim dblMinus(1) As Double

dblPlus(0) = 99.4
dblPlus(1) = 99.5
dblMinus(0) = -99.4
dblMinus(1) = -99.5

'Int 関数
'引数の小数部分を取り除いた整数値を返します。
Debug.Print Int(dblPlus(0))
Debug.Print Int(dblPlus(1))
Debug.Print Int(dblMinus(0))
Debug.Print Int(dblMinus(1))
'     99
'     99
'   -100
'   -100

'Fix 関数
'引数の小数部分を取り除いた整数値を返します。
Debug.Print Fix(dblPlus(0))
Debug.Print Fix(dblPlus(1))
Debug.Print Fix(dblMinus(0))
Debug.Print Fix(dblMinus(1))
'    99
'    99
'   -99
'   -99

'データ型変換関数
'CInt 関数
'値を整数型 (Integer) に変換します。
Debug.Print CInt(dblPlus(0))
Debug.Print CInt(dblPlus(1))
Debug.Print CInt(dblMinus(0))
Debug.Print CInt(dblMinus(1))
'     99
'    100
'    -99
'   -100

'Format 関数
'式を指定した書式に変換し、値を返します。
Debug.Print Format(dblPlus(0), "0")
Debug.Print Format(dblPlus(1), "0")
Debug.Print Format(dblMinus(0), "0")
Debug.Print Format(dblMinus(1), "0")
'     99
'    100
'    -99
'   -100

'Round 関数
'指定された小数点位置で丸めた数値を返します。
'引数２を省略すると、Round 関数は整数値を返します。
Debug.Print Round(dblPlus(0), 0)
Debug.Print Round(dblPlus(1), 0)
Debug.Print Round(dblMinus(0), 0)
Debug.Print Round(dblMinus(1), 0)
'   　99
'    100
'    -99
'   -100

'Application.WorksheetFunction
'ワークシート関数を使用する
'Round　四捨五入
'引数２を省略すると、Round 関数は整数値を返します。
Debug.Print Application.WorksheetFunction.Round(dblPlus(0), 0)
Debug.Print Application.WorksheetFunction.Round(dblPlus(1), 0)
Debug.Print Application.WorksheetFunction.Round(dblMinus(0), 0)
Debug.Print Application.WorksheetFunction.Round(dblMinus(1), 0)
'     99
'    100
'    -99
'   -100

'RoundDown　切り捨て
'引数２を省略すると、RoundDown 関数は整数値を返します。
Debug.Print Application.WorksheetFunction.RoundDown(dblPlus(0), 0)
Debug.Print Application.WorksheetFunction.RoundDown(dblPlus(1), 0)
Debug.Print Application.WorksheetFunction.RoundDown(dblMinus(0), 0)
Debug.Print Application.WorksheetFunction.RoundDown(dblMinus(1), 0)
'    99
'    99
'   -99
'   -99

'RoundUp　切り上げ
'引数２を省略すると、RoundUp 関数は整数値を返します。
Debug.Print Application.WorksheetFunction.RoundUp(dblPlus(0), 0)
Debug.Print Application.WorksheetFunction.RoundUp(dblPlus(1), 0)
Debug.Print Application.WorksheetFunction.RoundUp(dblMinus(0), 0)
Debug.Print Application.WorksheetFunction.RoundUp(dblMinus(1), 0)
'    100
'    100
'   -100
'   -100

'プラス正値とマイナス負値の扱いに要注意ですが
'※エクセルが使える環境ですと「Application.WorksheetFunction」
'を使った方が用途が多いですね。

End Sub

関数三角関数と逆三角関数-逆三角関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgYZ_DegreeX(ByVal y As Double, ByVal z As Double _
, ByRef Dgr As Double, ByRef x As Double)
'************************************************
'逆三角関数-正弦yと正接zから角度と余弦xを算出する
'************************************************
'引数 y:正弦 123.456cmなど
'引数 z:正接 123.456cmなど
'角度:Thetaシータθ∠A
'条件：∟直角三角形
'縦位置（Y座標・正弦）÷斜位置（Z座標・正接）＝Sine（サイン・正弦）

Dim vPI As Double
'円周率(π)
vPI = 4 * Atn(1)

Dim ARC As Double
ARC = y / z

Dim ARCsin As Double
ARCsin = Atn(ARC / Sqr(-ARC * ARC + 1))

Dim dblDegree As Double
'ラジアンからディグリー(角度)を求る
dblDegree = (180 / vPI) * ARCsin

Dgr = dblDegree
x = z * Cos(ARCsin)
'x = y / Tan(ARCsin)

'縦位置（Y座標・Sine・サイン・正弦）ARCアーク
'横位置（X座標・Cosine・コサイン・余弦）ARCアーク
'斜位置（Z座標・Tangent・タンジェント・正接）ARCアーク

End Function

Private Sub test_TrgYZ_DegreeX()
    Dim Dgr As Double, x As Double
    Call TrgYZ_DegreeX(14.9982662331051, 18.02775638, Dgr, x)
    Debug.Print Dgr
    Debug.Print x
' 56.3
' 10.0026001668331
End Sub

Option Explicit

'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgXZ_DegreeY(ByVal x As Double, ByVal z As Double _
, ByRef Dgr As Double, ByRef y As Double)
'************************************************
'逆三角関数-余弦xと正弦zから角度と正弦yを算出する
'************************************************
'引数 x:余弦 123.456cmなど
'引数 z:正弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件：∟直角三角形
'横位置（X座標・余弦）÷斜位置（Z座標・正接）＝Cosine（コサイン・余弦）

Dim vPI As Double
'円周率(π)
vPI = 4 * Atn(1)

Dim ARC As Double
ARC = x / z

Dim ARCcos As Double
ARCcos = Atn(-ARC / Sqr(-ARC * ARC + 1)) + 2 * Atn(1)

Dim dblDegree As Double
'ラジアンからディグリー(角度)を求る
dblDegree = (180 / vPI) * ARCcos

Dgr = dblDegree
y = x * Tan(ARCcos)
'y = z * Sin(ARCcos)

'縦位置（Y座標・Sine・サイン・正弦）ARCアーク
'横位置（X座標・Cosine・コサイン・余弦）ARCアーク
'斜位置（Z座標・Tangent・タンジェント・正接）ARCアーク

End Function

Private Sub test_TrgXZ_DegreeY()
    Dim Dgr As Double, y As Double
    Call TrgXZ_DegreeY(10.0026001668331, 18.02775638, Dgr, y)
    Debug.Print Dgr
    Debug.Print y
' 56.3000000000001
' 14.9982662331051
End Sub

Option Explicit

'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgXY_DegreeZ(ByVal x As Double, ByVal y As Double _
, ByRef Dgr As Double, ByRef z As Double)
'************************************************
'逆三角関数-余弦xと正弦yから角度と正接zを算出する
'************************************************
'引数 x:余弦 123.456cmなど
'引数 y:正弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件：∟直角三角形
'縦位置（Y座標・正弦）÷横位置（X座標・余弦）＝Tangent（タンジェント・正接）

Dim vPI As Double
'円周率(π)
vPI = 4 * Atn(1)

Dim ARC As Double
ARC = y / x

Dim Arctan As Double
Arctan = Atn(ARC)

Dim dblDegree As Double
'ラジアンからディグリー(角度)を求る
dblDegree = (180 / vPI) * Arctan

Dgr = dblDegree
z = y / Sin(Arctan)
'z = x / Cos(Arctan)

'縦位置（Y座標・Sine・サイン・正弦）ARCアーク
'横位置（X座標・Cosine・コサイン・余弦）ARCアーク
'斜位置（Z座標・Tangent・タンジェント・正接）ARCアーク

End Function

Private Sub test_TrgXY_DegreeZ()
    Dim Dgr As Double, z As Double
    Call TrgXY_DegreeZ(10.0026001668331, 14.9982662331051, Dgr, z)
    Debug.Print Dgr
    Debug.Print z
' 56.3
' 18.02775638
End Sub

関数三角関数と逆三角関数-三角関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgDegreeZ_YX(ByVal Dgr As Double, ByVal z As Double _
, ByRef y As Double, ByRef x As Double)
'************************************************
'三角関数-角度と正接zから正弦yと余弦xを算出する
'************************************************
'引数 Dgr:角度 45度など
'引数 z:正接 123.456cmなど
'角度:Thetaシータθ∠A
'条件：∟直角三角形

Dim dblRadian As Double, vPI As Double
vPI = 4 * Atn(1) '円周率(π)
dblRadian = (vPI / 180) * Dgr 'ディグリー(角度)からラジアンを求る

y = z * Sin(dblRadian)
x = z * Cos(dblRadian)

'縦位置（Y座標・Sine・サイン・正弦）ARCアーク
'横位置（X座標・Cosine・コサイン・余弦）ARCアーク
'斜位置（Z座標・Tangent・タンジェント・正接）ARCアーク

End Function

Private Sub test_TrgDegreeZ_YX()
    Dim y As Double, x As Double
    Call TrgDegreeZ_YX(56.3, 18.02775638, y, x)
    Debug.Print y
    Debug.Print x
' 14.9982662331051
' 10.0026001668331
End Sub

Option Explicit

'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgDegreeX_ZY(ByVal Dgr As Double, ByVal x As Double _
, ByRef z As Double, ByRef y As Double)
'************************************************
'三角関数-角度と余弦xから正接zと正弦yを算出する
'************************************************
'引数 Dgr:角度 45度など
'引数 x:余弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件：∟直角三角形

Dim dblRadian As Double, vPI As Double
vPI = 4 * Atn(1) '円周率(π)
dblRadian = (vPI / 180) * Dgr 'ディグリー(角度)からラジアンを求る

z = x / Cos(dblRadian)
y = x * Tan(dblRadian)

'縦位置（Y座標・Sine・サイン・正弦）ARCアーク
'横位置（X座標・Cosine・コサイン・余弦）ARCアーク
'斜位置（Z座標・Tangent・タンジェント・正接）ARCアーク

End Function

Private Sub test_TrgDegreeX_ZY()
    Dim z As Double, y As Double
    Call TrgDegreeX_ZY(56.3, 10.0026001668331, z, y)
    Debug.Print z
    Debug.Print y
' 18.02775638
' 14.9982662331051
End Sub

Option Explicit

'Trigonometric & Inverse Trigonometric Function
'三角関数と逆三角関数

Function TrgDegreeY_ZX(ByVal Dgr As Double, ByVal y As Double _
, ByRef z As Double, ByRef x As Double)
'************************************************
'三角関数-角度と正弦yから正接zと余弦xを算出する
'************************************************
'引数 Dgr:角度 45度など
'引数 y:正弦 123.456cmなど
'角度:Thetaシータθ∠A
'条件：∟直角三角形

Dim dblRadian As Double, vPI As Double
vPI = 4 * Atn(1) '円周率(π)
dblRadian = (vPI / 180) * Dgr 'ディグリー(角度)からラジアンを求る

z = y / Sin(dblRadian)
x = y / Tan(dblRadian)

'縦位置（Y座標・Sine・サイン・正弦）ARCアーク
'横位置（X座標・Cosine・コサイン・余弦）ARCアーク
'斜位置（Z座標・Tangent・タンジェント・正接）ARCアーク

End Function

Private Sub test_TrgDegreeY_ZX()
    Dim z As Double, x As Double
    Call TrgDegreeY_ZX(56.3, 14.9982662331051, z, x)
    Debug.Print z
    Debug.Print x
' 18.02775638
' 10.0026001668331
End Sub

関数高さと幅から斜線辺を求める-平方根

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

yとxから
zを求める。

Option Explicit

Function SquareRoot(y As Double, x As Double) As Double
'*************************************
'高さと幅から斜線辺を求める-平方根
'*************************************
'正弦と余弦から正接を求める
'引数yには高さ、xには幅
'ピタゴラス

If (x ^ 2 + y ^ 2) > 0 Then
SquareRoot = Sqr(x ^ 2 + y ^ 2)
Else
SquareRoot = 0
End If

'Sqr 関数
'数式の平方根を倍精度浮動小数点数型 (Double) の値で返す数値演算関数です。
'
'構文
'Sqr (Number)
'
'引数 number は必ず指定します。
'引数 number には、0 以上の倍精度浮動小数点数型 (Double) の数値または
'任意の有効な数式を指定します。

End Function

Private Sub test()
Debug.Print SquareRoot(15, 10)
'18.0277563773199
End Sub

関数現在の日付と時間を文字型で返す関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Function DateTimeName() As String

'’現在の日付と時間を文字型で返す関数
'’引数：なし
'’返値：現在の西暦、月日、時分秒を繋げた文字型を返す

DateTimeName = "(" & Year(Date) & Format(Month(Date), "00") & _
Format(Day(Date), "00") & Format(Hour(Time), "00") & _
Format(Minute(Time), "00") & Format(Second(Time), "00") & ")"

End Function

Private Sub Test()
MsgBox DateTimeName
End Sub

関数財務に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'減価償却の計算 DDB, SLN, SYD
'将来価値の計算 FV
'利息率を計算 Rate
'内部利益率の計算 IRR, MIRR
'投資期間の計算 NPer
'支払額の計算 IPmt, Pmt, PPmt
'現在価値の計算 NPV, PV

関数データ型変換関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'【CBool】ブール型 (Boolean)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   任意の有効な文字列または数式

'【CByte】バイト型 (Byte)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   0 ～ 255

'【CCur】通貨型 (Currency)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -922,337,203,685,477.5808 ～ 922,337,203,685,477.5807

'【CDate】日付型 (Date)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   任意の有効な日付式

'【CDbl】倍精度浮動小数点数型 (Double)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  -1.79769313486231E308    ～  -4.94065645841247E-324  (負の値)。
'   4.94065645841247E-324   ～   1.79769313486232E308   (正の値)。

'【CDec】10 進型 (Decimal)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   <<小数点以下が 0 桁 (小数部分を持たない数値) の場合>>
'   -79,228,162,514,264,337,593,543,950,335 ～ 79,228,162,514,264,337,593,543,950,335。
'   <<小数点以下 28 桁の数値の場合>>
'   -7.9228162514264337593543950335 ～ 7.9228162514264337593543950335。
'   <<絶対値の最小値は 0 を除いた場合>>
'   0.0000000000000000000000000001。
'
'【CInt】整数型 (Integer)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -32,768 ～ 32,767。小数部分は丸められます。

'【CLng】長整数型 (Long)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -2,147,483,648 ～ 2,147,483,647。小数部分は丸められます。

'【CSng】単精度浮動小数点数型 (Single)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   -3.402823E38 ～ -1.401298E-45 (負の値)、および 1.401298E-45 ～ 3.402823E38 (正の値)。

'【CVar】バリアント型 (Variant)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   数値の場合は倍精度浮動小数点数型の範囲と同じ。数値以外の場合は、文字列型の範囲と同じ。

'【CStr】文字列型 (String)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   CStr 関数の戻り値は引数 expression により異なります。

関数エクセル関数にあってVBAにない関数一覧(三角関数)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

名称	EXCEL	VBA
スクエア	SQRT	Sqr 関数

サイン	SIN	Sin 関数
コサイン	COS	Cos 関数
タンジェント	TAN	Tan 関数

セカント	なし	Sec(X) = 1 / Cos(X)
コセカント	なし	Cosec(X) = 1 / Sin(X)
コタンジェント	なし	Cotan(X) = 1 / Tan(X)

アークサイン	ASIN	Arcsin(X) = Atn(X / Sqr(-X * X + 1))
アークコサイン	ACOS	Arccos(X) = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
アークタンジェント	ATAN	Atn 関数

アークセカント	なし	Arcsec(X) = Atn(X / Sqr(X * X - 1)) + Sgn((X) - 1) * (2 * Atn(1))
アークコセカント	なし	Arccosec(X) = Atn(X / Sqr(X * X - 1)) + (Sgn(X) - 1) * (2 * Atn(1))
アークコタンジェント	なし	Arccotan(X) = Atn(X) + 2 * Atn(1)

双曲線サイン	SINH	HSin(X) = (Exp(X) - Exp(-X)) / 2
双曲線コサイン	COSH	HCos(X) = (Exp(X) + Exp(-X)) / 2
双曲線タンジェント	TANH	HTan(X) = (Exp(X) - Exp(-X)) / (Exp(X) + Exp(-X))

双曲線セカント	なし	HSec(X) = 2 / (Exp(X) + Exp(-X))
双曲線コセカント	なし	HCosec(X) = 2 / (Exp(X) - Exp(-X))
双曲線コタンジェント	なし	HCotan(X) = (Exp(X) + Exp(-X)) / (Exp(X) - Exp(-X))

双曲線アークサイン	ASINH	HArcsin(X) = Log(X + Sqr(X * X + 1))
双曲線アークコサイン	ACOSH	HArccos(X) = Log(X + Sqr(X * X - 1))
双曲線アークタンジェント	ATANH	HArctan(X) = Log((1 + X) / (1 - X)) / 2

双曲線アークセカント	なし	HArcsec(X) = Log((Sqr(-X * X + 1) + 1) / X)
双曲線アークコセカント	なし	HArccosec(X) = Log((Sgn(X) * Sqr(X * X + 1) + 1) / X)
双曲線アークコタンジェント	なし	HArccotan(X) = Log((X + 1) / (X - 1)) / 2

関数 Str関数とCStr関数の違い

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub StrAndCStrFunction()
'******************************
'Str関数とCStr関数の違い
'******************************
Dim i As Long

i = 1234 '正の値
Debug.Print Len(i) '4を返す
Debug.Print Len(Str(i)) '5を返す
Debug.Print Len(CStr(i)) '4を返す
Debug.Print Len(Trim(Str(i))) '4を返す

i = -1234 '負の値
Debug.Print Len(i)  '4を返す
Debug.Print Len(Str(i))  '5を返す
Debug.Print Len(CStr(i))  '5を返す
Debug.Print Len(Trim(Str(i)))  '5を返す

'Str関数は正の値（プラス値）の場合「+」の代わりにスペースを付加する

End Sub

関数 Win32-API関数プロセス/スレッドの関数一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

プラットフォーム SDK
[Win32 API 関数]プロセス/スレッドの関数
関数	説明
AssignProcessToJobObject	プロセスを既存のジョブオブジェクトに関連付けます。
AttachThreadInput	特定のスレッドの入力処理機構を別のスレッドにアタッチします。
BindIoCompletionCallback	スレッドプールの非 I/O ワーカースレッドのキューにコールバック関数を入れます。
CommandLineToArgvW	Unicode ワイド文字で渡されたコマンドライン文字列を解析します。
ConvertThreadToFiber	現在のスレッドをファイバに変換します。
CreateFiber	ファイバオブジェクトを確保し、そのオブジェクトにスタックを割り当て、指定された開始アドレスから実行を開始するための準備を行います。
CreateJobObject	ジョブオブジェクトを作成します。
CreateProcess	新しい 1 個のプロセスと、そのプライマリスレッドを作成します。新しいプロセスは、指定された実行可能ファイルを実行します。
CreateProcessAsUser	新しいプロセスとそのプライマリスレッドを返します。
CreateProcessWithLogonW	新しいプロセスとそのプライマリスレッドを作成します。
CreateRemoteThread	別のプロセスのアドレス空間で稼働するスレッドを作成します。
CreateThread	呼び出し側プロセスの仮想アドレス空間で実行するべき 1 個のスレッドを作成します。
DeleteFiber	既存のファイバを削除します。
ExitProcess	1 つのプロセスと、そのプロセスに所属するすべてのスレッドを終了させます。
ExitThread	1 つのスレッドを終了させます。
FiberProc	CreateFiber 関数とともに使うアプリケーション定義関数です。ファイバの開始アドレスの役割を果たします。
FreeEnvironmentStrings	複数の環境文字列からなる 1 個の環境ブロックを解放します。
GetCommandLine	現在のプロセスのコマンドライン文字列へのポインタを取得します。
GetCurrentFiber	カレントファイバのアドレスを返します。
GetCurrentProcess	現在のプロセスに対応する疑似ハンドルを取得します。
GetCurrentProcessId	呼び出し側プロセスのプロセス識別子を取得します。
GetCurrentThread	現在のスレッドの擬似ハンドルを取得します。
GetCurrentThreadId	呼び出し側スレッドのスレッド識別子を取得します。
GetEnvironmentStrings	現在のプロセスに対応する環境ブロックへのポインタを取得します。
GetEnvironmentVariable	呼び出し側プロセスの環境ブロックから、指定された環境変数の値を取得します。この値は、NULL で終わる文字列です。
GetExitCodeProcess	指定されたプロセスの終了ステータスを取得します。
GetExitCodeThread	指定されたスレッドの終了ステータスを取得します。
GetFiberData	カレントファイバに関連付けられたファイバデータを返します。
GetGuiResources	このドキュメントの内容は、まだ確定されていないため将来変更される可能性があります。
GetPriorityClass	指定されたプロセスの優先順位クラスを返します。
GetProcessAffinityMask	指定されたプロセスのプロセスアフィニティマスクとシステムのシステムアフィニティマスクを返します。
GetProcessPriorityBoost	指定されたプロセスのプライオリティブースト制御の状態を返します。
GetProcessShutdownParameters	呼び出し側プロセスのシャットダウンパラメータを取得します。
GetProcessTimes	指定されたプロセスに関する時間情報を取得します。
GetProcessVersion	指定されたプロセスが、実行に当たって想定している Windows のメジャーバージョンとマイナーバージョンを取得します。
GetProcessWorkingSetSize	指定されたプロセスの最大ワーキングセットサイズと最小ワーキングセットサイズを取得します。
GetStartupInfo	呼び出し側プロセスを作成する際に指定された、構造体の内容を取得します。
GetThreadPriority	指定されたスレッドの相対優先順位値を取得します。
GetThreadPriorityBoost	指定されたスレッドのプライオリティブースト制御の状態を返します。
GetThreadTimes	指定されたスレッドに関する時間情報を取得します。
GetTimestampForLoadedLibrary	ロード済みイメージのタイムスタンプを取得します。
OpenJobObject	既存のジョブオブジェクトを開きます。
OpenProcess	既存のプロセスオブジェクトのハンドルを開きます。
OpenThread	既存のスレッドオブジェクトのハンドルを取得します。
QueryInformationJobObject	ジョブオブジェクトからリミットとジョブの状態に関する情報を取得します。
QueueUserWorkItem	内のワーカースレッドのキューに作業項目を入れます。
ResumeThread	スレッドのサスペンド (中断) カウントを 1 減らします。
SetEnvironmentVariable	現在のプロセスに対応する 1 つの環境変数の値を設定します。
SetInformationJobObject	ジョブオブジェクトのリミットを設定します。
SetPriorityClass	指定されたプロセスの優先順位クラスを設定します。
SetProcessAffinityMask	指定したプロセスに属するスレッドのプロセッサアフィニティマスクを設定します。
SetProcessPriorityBoost	指定されたプロセスに属するスレッドについて、特定のスレッドの優先順位を一時的に上げる Windows NT のブースト機能を無効にします。
SetProcessShutdownParameters	呼び出し側プロセスのシャットダウンパラメータを設定します。
SetProcessWorkingSetSize	指定されたプロセスの最小ワーキングセットサイズと最大ワーキングセットサイズを設定します。
SetThreadAffinityMask	指定されたスレッドのプロセッサアフィニティマスクを設定します。
SetThreadIdealProcessor	スレッドの優先プロセッサを指定するときに使います。
SetThreadPriority	指定されたスレッドの相対優先順位値を設定します。
SetThreadPriorityBoost	スレッドの優先順位を一時的に上げる Windows NT の機能を無効にします。
Sleep	指定された時間にわたって、現在のスレッドの実行を中断します。
SleepEx	現在のスレッドを中断します。次の条件のいずれかが満たされると、実行を再開します。
SuspendThread	指定されたスレッドの実行を中断します。
SwitchToFiber	ファイバをスケジューリングします。
SwitchToThread	呼び出し側スレッドから現在のプロセッサで実行する準備ができている別のスレッドに実行を譲渡します。
TerminateJobObject	ジョブに関連付けられているすべてのプロセスを終了します。
TerminateProcess	指定されたプロセスと、そのプロセスに所属するすべてのスレッドを終了させます。
TerminateThread	1 つのスレッドを終了させます。
ThreadProc	スレッドの開始アドレスの役割を果たすアプリケーション定義関数です。
TlsAlloc	スレッドローカル記憶域 (TLS) インデックスを確保します。
TlsFree	スレッドローカル記憶域 (TLS) インデックスを解放し、再利用できるようにします。
TlsGetValue	TlsGetValue 関数は、呼び出し側スレッドの、指定された TLS インデックスに対応するスレッドローカル記憶域 (TLS) スロットに入っている値を取得します。
TlsSetValue	呼び出し側スレッドの、指定された TLS インデックスに対応するスレッドローカル記憶域 (TLS) スロットに値を入れます。
UserHandleGrantAccess	ユーザーインターフェイス制限の付いたジョブに USER ハンドルへのアクセス権を与えます。
WaitForInputIdle	指定されたプロセスで未処理の入力が存在せず、ユーザーからの入力を待っている状態になるまで、またはタイムアウト時間が経過するまで待機します。
WinExec	指定されたアプリケーションを実行します。
Yield	16 ビット版 Windows との互換性を維持するためだけに残されているもので、今後廃止されます。Win32 ベースのアプリケーションプログラミングインターフェイス (API) では、この関数は何もしません。

関数関数名にドル記号($)は何か？

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FunctionDollarMark()
'********************************
'関数名にドル記号($)は何か？
'********************************
'ペルプ抜粋

'次の関数は関数名にドル記号 ($) を追加すると、文字列型 (String) の値を返します。
'これらの関数は、ドル記号を付けずに使用すると、バリアント型 (Variant) の値を返します。

'Chr$
'ChrB$
'CurDir$
'Date$
'Dir$
'Error$
'Format$
'Hex$
'Input$
'InputB$
'LCase$
'Left$
'LeftB$
'LTrim$
'Mid$
'MidB$
'Oct$
'Right$
'RightB$
'RTrim$
'Space$
'Str$
'String$
'Time$
'Trim$
'UCase$

'バリアント型 (Variant) を返す形式
    '*異なるデータ型への変換が自動的に行われるので便利です。
    '*この形式を使用すると、Null 値を式で渡すことができます。
'文字列型 (String) を返す形式
    '*使用するメモリが少ないため、より効率的です。

End Sub

関数円周率(π)ディグリー(角度)ラジアンを求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function vbPI() As Double
'**********************************
'円周率(π)を求る
'**********************************
'Atn関数を利用(アークタンジェント)
'VB・VBAには円周率関数が無い
'返値=近似値

'ワークシート関数を使わないで求める
vbPI = 4 * Atn(1)

'※エクセルVBAの場合、ワークシート関数からでも求める事が可能
'vbPI = Application.WorksheetFunction.PI
End Function

Function Radian(Degrees As Double) As Double
'**********************************
'ディグリー(角度)からラジアンを求る
'**********************************
'返値=近似値
'ラジアン＝円周率÷180×ディグリー
'円周率π=3.14159265358979

Radian = (vbPI / 180) * Degrees

End Function

Function Degree(Radian As Double) As Double
'**********************************
'ラジアンからディグリー(角度)を求る
'**********************************
'返値=近似値
'ディグリー＝円周率÷180×ラジアン
'円周率π=3.14159265358979

Degree = (180 / vbPI) * Radian

End Function

Private Sub test()
''円周率πを求る
Debug.Print vbPI()
'3.14159265358979

''ディグリー(角度)からラジアンを求る
Debug.Print Radian(90)
'1.5707963267949

''ラジアンからデグリー(角度)を求る
Debug.Print Degree(1.5707963267949)
'90.0000000000002

End Sub

関数逆三角関数x-y座標のアークタンジェントを返しますAtan2無使用

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function Atan2VBversion(x As Double, y As Double) As Double
'**********************************************************
'逆三角関数x-y座標のアークタンジェントを返しますAtan2無使用
'**********************************************************
'戻り値の角度は度
'引数x:x座標を指定
'引数y:y座標を指定
'※エクセルWorksheetFunctionAtan2無使用

    Dim vPI As Double, At2 As Double
    vPI = 4 * Atn(1) '円周率(π)
    If x > 0 Then
        At2 = Atn(y / x)
    ElseIf x < 0 Then
        At2 = Sgn(y) * (vPI - Atn(Abs(y / x)))
    ElseIf y = 0 Then
        At2 = 0
    Else
        At2 = Sgn(y) * vPI / 2
    End If
    '====================================
    'ラジアン値が必要な場合は削除       |
    'ラジアンからディグリー(角度)を求る |
    At2 = (180 / vPI) * At2 '           |
    '====================================
    Atan2VBversion = At2

End Function

Function Atan2XLSversion(x As Double, y As Double) As Double
'**********************************************************
'逆三角関数x-y座標のアークタンジェントを返します
'**********************************************************
'戻り値の角度は度
'引数x:x座標を指定
'引数y:y座標を指定
'※エクセルWorksheetFunctionAtan2使用

    Dim At2 As Double

    At2 = Application.WorksheetFunction.Atan2(x, y)

    '====================================================
    'ラジアン値が必要な場合は削除                       |
    'ラジアンからディグリー(角度)を求る                 |
    At2 = Application.WorksheetFunction.Degrees(At2) '  |
    '====================================================
    Atan2XLSversion = At2

End Function

Private Sub test()
Debug.Print Atan2VBversion(10, 15)
Debug.Print Atan2XLSversion(10, 15)
' 56.3099324740202
' 56.3099324740202

End Sub

Atan2

ワークシート関数
指定された x-y 座標のアークタンジェントを返します。
アークタンジェントとは、x 軸から、原点 0 と x座標、y座標で表される点を結んだ直線までの角度のことです。
戻り値の角度は、-PI ～ PI (ただし -PI を除く) の範囲のラジアンとなります。
書式
ATAN2(x座標, y座標)
x座標点の x 座標を指定します。
y座標点の y 座標を指定します。
解説
戻り値が正の数なら x 軸から反時計回りの角度を表し、負の数なら x 軸から時計回りの角度を表します。
ATAN2(a,b) = ATAN(b/a) という関係になりますが、ATAN2 関数では、a に 0 を指定することができます。
x座標と y座標が両方とも 0 である場合、エラー値 #DIV/0 が返されます。
アークタンジェントの値を度で表すには、計算結果に 180/PI() を掛けます。
使用例
ATAN2(1, 1) = 0.785398 (PI/4 ラジアン)
ATAN2(-1, -1) = -2.35619 (-3*PI/4 ラジアン)
ATAN2(-1, -1)*180/PI() = -135 (度)

Atn 関数

指定した数値のアークタンジェントを倍精度浮動小数点数型 (Double) で返します。
構文
Atn (Number)
引数 number は必ず指定します。引数 number には、倍精度浮動小数点数型 (Double) の数値または任意の数式を指定します。
解説
Atn 関数は、直角三角形の 2 辺の比を引数 (number) として受け取り、対応する角度を返します。
ここでいう 2 辺とは、直角をはさむ 2 つの辺を指します。
2 辺の比は、求める角の反対側の辺 (対辺) の長さをもう一方の辺 (底辺、つまり求める角に隣接する側の辺) の長さで割った値です。
戻り値は、-π/2 ～π/2 の範囲の値 (単位はラジアン) になります。
角度の単位を度からラジアンに変換するには、度にπ/180 を掛けます。ラジアンから度に変換するには、ラジアンに 180/πを掛けます。
メモ
Atn 関数は Tan 関数の逆三角関数です。
Tan 関数は、引数として角度を受け取り、その角度を含む直角三角形の直角をはさむ 2 辺の比を返します。
Atn 関数と、タンジェントの逆数であるコタンジェント (1/タンジェント) の違いに気を付けてください。

Sgn 関数

引数に指定した値の符号をバリアント型 (内部処理形式 Integer の Variant) の値で返す数値演算関数です。
構文
Sgn(number)
引数
number は必ず指定します。引数 number には、任意の数式を指定します。
戻り値
number の値戻り値
number > 0 1
number = 0 0
number < 0 -1
解説
引数 number の符号により、Sgn 関数の戻り値が決まります。

関数 MsgBox関数の引数の値と戻り値

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MsgBox 関数の定数
MsgBox 関数の引数の値
定数	値	内容

vbOKOnly	0	(既定値) [OK] ボタンのみを表示します。
vbOKCancel	1	[OK] ボタンと [キャンセル] ボタンを表示します。
vbAbortRetryIgnore	2	[中止]、[再試行]、[無視] の 3 つのボタンを表示します。
vbYesNoCancel	3	[はい]、[いいえ]、[キャンセル] の 3 つのボタンを表示します。
vbYesNo	4	[はい] ボタンと [いいえ] ボタンを表示します。
vbRetryCancel	5	[再試行] ボタンと [キャンセル] ボタンを表示します。
vbMsgBoxHelpButton	16384	ヘルプボタンを追加します。

vbCritical	16	警告メッセージアイコンを表示します。
vbQuestion	32	問い合わせメッセージアイコンを表示します。
vbExclamation	48	注意メッセージアイコンを表示します。
vbInformation	64	情報メッセージアイコンを表示します。

vbDefaultButton1	0	(既定値)第 1 ボタンを標準ボタンに設定します。
vbDefaultButton2	256	第 2 ボタンを標準ボタンに設定します。
vbDefaultButton3	512	第 3 ボタンを標準ボタンに設定します。
vbDefaultButton4	768	第 4 ボタンを標準ボタンに設定します。

vbApplicationModal	0	(既定値)アプリケーションモーダルに設定します。
vbSystemModal	4096	システムモーダルに設定します。

VbMsgBoxSetForeground	65536	最前面のウィンドウとして表示します。

vbMsgBoxRight	524288	テキストを右寄せで表示します。
vbMsgBoxRtlReading	1048576	テキストを、右から左の方向で表示します。
MsgBox 関数の戻り値
定数	値	内容 (選択されたボタン)
vbOK	1	[OK]
vbCancel	2	[キャンセル]
vbAbort	3	[中止]
vbRetry	4	[再試行]
vbIgnore	5	[無視]
vbYes	6	[はい]
vbNo	7	[いいえ]
Option Explicit Sub MsgboxTest() Dim msg As Variant, str As String str = "MsgboxTest" msg = MsgBox("あいうえお", vbYesNoCancel + 64 + 524288 + 512, str) If msg = 7 Then MsgBox "[いいえ]が選択されました", 16, str ElseIf vbCancel Then MsgBox "[キャンセル]が選択されました", 48, str End If End Sub

関数 Hex関数16進数で表した文字列と逆変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

10 進数の場合	16 進数の場合
000000	000000
000001	000001
000002	000002
000003	000003
000004	000004
000005	000005
000006	000006
000007	000007
000008	000008
000009	000009
000010	00000A
000011	00000B
000012	00000C
000013	00000D
000014	00000E
000015	00000F
000016	000010
000017	000011
000018	000012
・	・
・	・
16777215	FFFFFF

Option Explicit

Sub HexTest()
'***************************************
'Hex関数16進数で表した文字列と逆変換
'***************************************
Dim i As Byte
For i = 0 To 18
Debug.Print "[ " & Right("000000" & Hex(i), 6) & " ]"
Next i
Debug.Print "[ " & CLng("&H" & "000000") & " ]"
Debug.Print "[ " & CLng("&H" & "FFFFFF") & " ]"
'[ 000000 ]
'[ 000001 ]
'[ 000002 ]
'[ 000003 ]
'[ 000004 ]
'[ 000005 ]
'[ 000006 ]
'[ 000007 ]
'[ 000008 ]
'[ 000009 ]
'[ 00000A ]
'[ 00000B ]
'[ 00000C ]
'[ 00000D ]
'[ 00000E ]
'[ 00000F ]
'[ 000010 ]
'[ 000011 ]
'[ 000012 ]
'[ 0 ]
'[ 16777215 ]
End Sub

Hex 関数

指定した値を 16 進数で表した文字列型 (String) を返します。

構文
Hex(number)
引数 number には
、任意の数式または文字列式を指定します。この引数は必ず指定します。
解説
引数 number が整数でない場合、変換の前に一番近い整数に丸められます。
number の値戻り値
Null 値 Null 値
Empty 値 0
その他の数値 16 進数を表す最大 8 桁の文字列
適切な範囲の数値の前に &H を付けて記述すると、値を直接 16 進数で記述することができます。
たとえば、10 進数の 16 を &H10 のように 16 進数で表記することができます。

関数 LBound(小)関数とUBound(大)関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

LBound 関数
UBound 関数

LBound 関数

配列の指定された次元で使用できる最小の添字を、長整数型 (Long)の値で返します。

構文
LBound(arrayname[, dimension])
LBound 関数の構文は、次の指定項目から構成されます。
指定項目内容
arrayname
必ず指定します。配列変数の名前です。変数の標準的な名前付け規則に従って指定します。
dimension
省略可能です。バリアント型 (内部処理形式 Long の Variant) の値を指定します。添字の最小値を調べる対象となる配列の次元を示す整数を指定します。最初の次元なら 1、2 番目の次元なら 2、というように指定します。引数 dimension を省略すると、1 が指定されたものと見なされます。
解説
LBound 関数
は、UBound 関数と組み合わせて、配列のサイズを調べるために使います。配列の添字の最大値を調べるには、UBound 関数を使います。
次のような配列が宣言されている場合
、LBound 関数からは下の表のような値が返ります。
Dim A(1 To 100, 0 To 3, -3 To 4)
ステートメント戻り値
LBound(A, 1) 1
LBound(A, 2) 0
LBound(A, 3) -3
配列の添字の最小値の既定値は、0 または 1 です。
この値は、Option Base ステートメントの設定によって決まります。Array 関数で作成された配列の添字は、0 から始まり、Option Base ステートメントの影響は受けません。
Dim、Private、Public、ReDim、Static のいずれかのステートメントで To 節を使って配列の次元を設定すると、添字の最小値に任意の整数値を指定できます。

LBound 関数の使用例

次の例では、LBound 関数を使って、配列内の指定された次元の添字として使える最小値を求めます。配列の添字の既定の最小値 0 を変更するには、Option Base ステートメントを使います。

Option Explicit

Dim Lower
    ' 配列変数を宣言します。
Dim MyArray(1 To 10, 5 To 15, 10 To 20)
Dim AnyArray(10)
Lower = LBound(MyArray, 1)     ' 1 を返します。
Lower = LBound(MyArray, 3)     ' 10 を返します。
Lower = LBound(AnyArray)
            ' Option Base の設定に応じて、0 または 1 を返します。

UBound 関数

配列の指定された次元で使用できる添字の最大値を、長整数型 (Long) の値で返します。

構文
UBound(arrayname[, dimension])
UBound 関数の構文は、次の指定項目から構成されます。
指定項目内容
arrayname
必ず指定します。配列変数の名前です。変数の標準的な名前付け規則に従って指定します。
dimension
省略可能です。バリアント型 (内部処理形式 Long の Variant) の値を指定します。添字の最大値を調べる対象となる配列の次元を示す整数を指定します。最初の次元なら 1、2 番目の次元なら 2、というように指定します。引数 dimension を省略すると、1 が指定されたものと見なされます。
解説
UBound 関数
は、LBound 関数と組み合わせて、配列のサイズを調べるために使います。配列の添字の最小値を調べるには、LBound 関数を使います。
次のような配列が宣言されている場合
、UBound 関数からは下の表のような値が返ります。
Dim A(1 To 100, 0 To 3, -3 To 4)
ステートメント戻り値
UBound(A, 1) 100
UBound(A, 2) 3
UBound(A, 3) 4

UBound 関数の使用例

次の例では、UBound 関数を使って、配列の指定された次元の添字として使える最大値を求めます。

Option Explicit

Dim Upper
Dim MyArray(1 To 10, 5 To 15, 10 To 20)
                                ' 配列変数を宣言します。
Dim AnyArray(10)
Upper = UBound(MyArray, 1)      ' 10 が返ります。
Upper = UBound(MyArray, 3)      ' 20 が返ります。
Upper = UBound(AnyArray)        ' 10 が返ります。

関数 FreeFile関数_使用可能なファイル番号を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

FreeFile 関数

使用可能なファイル番号を整数型 (Integer) の値で返すファイル入出力関数です。

構文
FreeFile[(rangenumber)]
引数
rangenumber
には、ファイル番号の範囲をバリアント型 (Variant) で指定します。指定した範囲から次に使用可能なファイル番号を返します。この引数は省略可能です。
0 (既定値)1 ～ 255 の範囲のファイル番号が返されます。
1256 ～ 511 の範囲のファイル番号が返されます。
解説
使用可能なファイル番号を取得するために FreeFile 関数を使用します。既に使われているファイル番号を重複して使うのを防ぐことができます。

FreeFile 関数の使用例

次の例は、FreeFile 関数を使って、次に使用可能なファイル番号を返します。この例では、ループ内で 5 つのファイルをシーケンシャル出力モード (Output) で開いています。各ファイルには、サンプルデータが書き込まれているものと仮定します。

Option Explicit

Dim MyIndex, FileNumber
' ループを 5 回繰り返します。
For MyIndex = 1 To 5
    ' 未使用のファイル番号を取得します。
    FileNumber = FreeFile
    ' ファイル名を作成します。
    Open "TEST" & MyIndex For Output As #FileNumber
    ' 文字列を出力します。
    Write #FileNumber, "これはサンプルです。"
    ' ファイルを閉じます。
    Close #FileNumber
Next MyIndex

関数 EOF関数ファイルの終端(末尾)かどうかを確認する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

EOF 関数

ランダムアクセスモード (Random) またはシーケンシャル入力モード (Input) で開いたファイルの現在位置がファイルの末尾に達している場合、ブール型 (Boolean) の値の真 (True) を含む整数型 (Integer) の値を返します。

構文
EOF(filenumber)
引数
filenumber
には、任意の有効なファイル番号を表す整数型 (Integer) の数値を指定します。この引数は必ず指定します。
解説
EOF 関数は、ファイルから読み込みを行っているとき、読み込み位置がファイルの末尾に達していないかどうかを確かめるために使用します。
EOF 関数はファイルの末尾に達していない場合は、偽 (False) を返します。ランダムアクセスモード (Random) またはバイナリモード (Binary) でファイルを開いた場合、EOF 関数は最後に実行された Get ステートメントでレコード全体が読み込めなくなるまで偽 (False) を返します。
バイナリモードでファイルを開いた場合、Input 関数を使用して EOF 関数が真 (True) を返すまでファイルを読み込もうとすると、エラーが発生します。Input 関数を使用してバイナリファイルを読み込む場合は、EOF 関数の代わりに、LOF 関数および Loc 関数を使用します。EOF 関数を使用する場合は、Get ステートメントを使用します。シーケンシャル出力モード (Output) で開いたファイルの場合は、常に真 (True) を返します。

EOF 関数の使用例

次の例は、EOF 関数を使って、ファイルの終端に達したかどうかを調べます。この例では、ファイル MYFILE は、複数行のデータを含むテキストファイルと仮定します。

Option Explicit

Dim InputData
' シーケンシャル入力モードで開きます。
Open "MYFILE" For Input As #1
' ファイルの終端かどうかを確認します。
Do While Not EOF(1)
    ' データ行を読み込みます。
    Line Input #1, InputData
    ' イミディエイトウィンドウに表示します。
    Debug.Print InputData
Loop
' ファイルを閉じます。
Close #1

関数 Functionステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'Function プロシージャの名前､引数､および本体部分を構成するコードを宣言します｡()
'
'構文
'
'[Public | Private | Friend] [Static] Function name [(arglist)] [As type]
'[statements]
'[name = expression]
'[Exit Function]
'[statements]
'[name = expression]
'
'
'Function ステートメントの構文は､次の指定項目から構成されます｡()
'
'指定項目
'Public
'Private
'Friend
'Static
'name
'arglist
'type
'statements
'expression
'
'引数 arglist は、次の形式で指定します。
'
'[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
'
'指定項目
'Optional
'ByVal
'ByRef
'ParamArray
'varname
'type
'defaultvalue
'
'解説
'
'キーワード Public、キーワード Private、またはキーワード Friend を指定しない場合、Function プロシージャはパブリックが既定値になります。キーワード Static を指定しない場合、ローカル変数の値は Function プロシージャの実行が終了すると破棄されます。キーワード Friend は、クラスモジュール内でのみ使えます。ただし、Friend を指定したプロシージャは、プロジェクト内のすべてのモジュールのプロシージャから呼び出せます。Friend を指定したプロシージャは、親クラスのタイプライブラリには書き込まれません。また、実行時バインディングは行えません。
'
'メモ Function プロシージャは、再帰的な使用、つまり、ある機能を実行するためにプロシージャ自体を呼び出すことができます。ただし、再帰呼び出しを行うと、スタックがオーバーフローする可能性があります。通常、キーワード Static は、再帰的な Function プロシージャでは使いません。
'
'実行可能なコードは、すべてプロシージャ内に記述する必要があります。Function プロシージャは、ほかの Function プロシージャ、Sub プロシージャ、Property プロシージャの中では、定義できません。
'
'Exit Function ステートメントは、Function プロシージャを直ちに終了します。プログラムの実行は、その Function プロシージャを呼び出したステートメントの次のステートメントから継続されます。Exit Function ステートメントは、Function プロシージャ内の任意の場所で必要に応じていくつでも指定できます。
'
'Sub プロシージャと同様に、Function プロシージャは、引数を受け取り、一連のステートメントを実行して、引数の値を変更します。ただし、Sub プロシージャとは異なり、Function プロシージャは、Sqr、Cos、Chr などの組み込み関数と同じように、式の右辺に記述して、関数の戻り値を使うことができます。
'
'式の中で Function プロシージャを呼び出すには、関数名の後にかっこで囲んだ引数リストを付けて使います。Function プロシージャを呼び出す方法については、Call ステートメントを参照してください。
'
'Function プロシージャから値を返すには、値を Function プロシージャ名に代入します。プロシージャ名には、Function プロシージャ内の任意の場所で、必要に応じて何回でも値を代入できます。プロシージャ名 name に値を代入しない場合、既定の戻り値が返されます。既定の戻り値は、Function プロシージャが数値型の場合は 0、文字列型の場合は長さ 0 の文字列 ("")、バリアント型の場合は Empty 値です。オブジェクトへの参照を返す Function プロシージャでは、プロシージャ内で Set ステートメントを使ってプロシージャ名 name にオブジェクトへの参照を代入しない場合は、Nothing が返されます。
'
'次の例では、BinarySearch という名前の Function プロシージャに戻り値を代入しています。ここでは、値が見つからなかったことを示す偽 (False) をプロシージャ名に代入しています。
'
'Function BinarySearch(. . .) As Boolean
'. . .
    ' 値が見つからないときは偽 (False) を返します。
    If lower > upper Then
        BinarySearch = False
        Exit Function
    End If
'. . .

'Function プロシージャで使う変数には、Function プロシージャ内で明示的に宣言される変数と、それ以外の変数の 2 種類があります。プロシージャ内で Dim などのステートメントで明示的に宣言された変数 (ローカル変数) は、そのプロシージャの中だけで有効です。プロシージャ内で明示的に宣言されていない変数も、そのプロシージャの外部のさらに上のレベルで明示的に宣言されていない限り、ローカル変数となります。
'
'メモプロシージャ内で明示的に宣言されていない変数をプロシージャ内で使うことは可能ですが、その変数と同じ名前の変数などがモジュールレベルで定義されている場合、名前の競合が発生します。あるプロシージャから、ほかのプロシージャ、定数または変数のいずれかと同じ名前を持つ未宣言の変数を参照した場合、そのモジュールレベルの名前を参照しているものと見なされます。変数を明示的に宣言すれば、このような名前の競合は避けられます。Option Explicit ステートメントを使うと、変数の明示的な宣言が強制されます。
'
'メモ Visual Basic では、演算効率を高めるために数式が自動的に並べ替えられることがあります。数式の中で使用している変数の値を変えてしまうような Function プロシージャは、同じ数式の中で実行しないようにしてください。

'Function ステートメントの使用例

'次の例では、Function ステートメントを使って、Function プロシージャの名前と引数を宣言し、プロシージャのコードを記述しています。最後の例では、既に定義されて、初期化された、キーワード Optional 指定の引数が使われています。

' 次のユーザー定義関数は、引数として渡された値の平方根を返します。
Function CalculateSquareRoot(NumberArg As Double) As Double
    If NumberArg < 0 Then            ' 引数を評価します。
        Exit Function    ' 終了して、呼び出し側のプロシージャに戻ります。
    Else
        CalculateSquareRoot = Sqr(NumberArg)
                                    ' 平方根を返します。
    End If
End Function

'関数が任意の数の引数を受け取るようにするには、キーワード ParamArray を使います。その例を次に示します。また、この例では、引数 FirstArg を値渡しで引き渡します。

Function CalcSum(ByVal FirstArg As Integer, ParamArray OtherArgs())
Dim ReturnValue

ReturnValue = CalcSum(4, 3, 2, 1)
' この関数を上のように呼び出すと、
' 配列の添字の最小値が既定値の 1 であれば、
' ローカル変数には FirstArg = 4、OtherArgs(1) = 3、
' OtherArgs(2) = 2 のように値が代入されます。
End Function

'キーワード Optional が指定された引数は、既定値とバリアント型 (Variant) 以外のデータ型を持つことができます。

' 関数の引数が次のように定義されているものとします。
Function MyFunc(MyStr As String, Optional MyArg1 As _
    Integer = 5, Optional MyArg2 = "Dolly")
Dim RetVal
' この関数は次のように呼び出すことができます。
RetVal = MyFunc("Hello", 2, "World")
                                ' 3 つの引数をすべて指定します。
RetVal = MyFunc("Test", , 5)    ' 2 番目の引数を省略します。
' 名前付き引数を使って、1 番目と 3 番目の引数を指定します。
RetVal = MyFunc(MyStr:="Hello ", MyArg1:=7)
End Function

関数 [WorksheetFunction.VLookup]の便利な使い方

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Function WorksheetFunctionVLookup(ByVal Geton As String) As String
'********************************************
'[WorksheetFunction.VLookup]の便利な使い方VBA
'********************************************
Dim str(1 To 3, 1 To 5) As String, Ans As String

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Dim str(3, 5) As String
'注意下記は上記と同じ変数ですが
'「Application.WorksheetFunction.VLookup」を使用する場合
'は上記のように範囲を1から○○までと指定しないと使えません。
'これはWorksheetFunctionではセル値に「0」が無く「1」から始まる為です。
'追記 str(3, 5)はstr(0 to 3, 0 to 5)と同じです。

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'テーブル----------------------------------------------------------------------------
str(1, 1) = 1: str(1, 2) = "い": str(1, 3) = "A": str(1, 4) = "あ": str(1, 5) = "a"
str(2, 1) = 2: str(2, 2) = "ろ": str(2, 3) = "B": str(2, 4) = "い": str(2, 5) = "b"
str(3, 1) = 3: str(3, 2) = "は": str(3, 3) = "C": str(3, 4) = "う": str(3, 5) = "c"
'------------------------------------------------------------------------------------

Ans = ""
  On Error Resume Next ' エラーのトラップを留保します。
    Ans = Application.WorksheetFunction.VLookup(Geton, str(), 4, False)
  On Error GoTo 0 'エラーのトラップを無効にします。

WorksheetFunctionVLookup = Ans

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'VLOOKUP(検索値, 範囲, 列番号, 検索の型)
'
'検索値:範囲の左端の列で検索する値を指定します。
'検索値には、値、セル参照、または文字列を指定します。
'英字の大文字と小文字は区別されません｡
'
'範囲:目的のデータが含まれるテーブルを指定します。
'範囲の左端の列のデータは､文字列､数値､論理値のいずれでもかまいません｡
'
'列番号:範囲内で目的のデータが入力されている列を、左端からの列数で指定します。
'列番号に 1 を指定すると、範囲の左端の列の値が返され、
'列番号に 2 を指定すると、範囲の左から 2 列目の値が返されます。
'列番号が 1 より小さいときは、エラー値 #VALUE! が返され、
'列番号が範囲の列数より大きいときは、エラー値 #REF! が返されます。
'
'検索の型に TRUE を指定した場合、
'範囲の左端の列のデータは、昇順に並べ替えておく必要があります。
'検索の型に FALSE を指定した場合は、範囲のデータを並べ替えておく必要はありません。
'検索の型検索値と完全に一致する値だけを検索するか、
'その近似値を含めて検索するかを､論理値で指定します｡
'TRUE を指定するか省略すると、検索値が見つからない場合に、
'検索値未満で最も大きい値が使用されます｡
'FALSE を指定すると、検索値と完全に一致する値だけが検索され、
'見つからない場合はエラー値 #N/A が返されます。
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Function

Private Sub test()
MsgBox WorksheetFunctionVLookup("3")
End Sub

関数高さと幅から斜線辺を求める-平方根

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

yとxから
zを求める。

Option Explicit

Private Sub test()
Debug.Print SquareRoot(15, 10)
'18.0277563773199
End Sub

アーク

もう一つの三角関数"逆三角関数"「アーク」

サイン・コサイン・タンジェントの他にそれらの文字の頭に「アーク」が付加する、
アークサイン・アークコサイン・アークタンジェントがあります。
サイン・コサイン・タンジェントはシータθ（角度）からX辺（コサイン）の長さやY辺（サイン）の長さを算出しましたが、
アークサイン・アークコサイン・アークタンジェントはサイン・コサイン・タンジェントからシータθ（角度）を算出します。
これらを逆三角関数と呼びます。
英名では Inverse Trigonometric Function
サイン・コサイン・タンジェントの「逆数」コセカント・セカント・コタンジェントとは全く違います。混同しないように！
- 逆数とは
- "x / y" → "y / x" , "z / y" → "y / z" のように式が逆になることです。

ACOS
- ARCCOS
- 数値のアークコサインを返します。
- アークコサインとは、そのコサインが数値であるような角度のことです。
- 戻り値の角度は、0(ゼロ) ～ PI の範囲のラジアンとなります。
- 書式
  - ACOS(数値)
  - 数値求める角度のコサインの値を、-1 ～ 1 の範囲で指定します。
  - アークコサインの値を度で表すには、計算結果に 180/PI() を掛けます。
  - 使用例
    - ACOS(-0.5) = 2.094395 (2PI/3 ラジアン)
    - ACOS(-0.5) = 120 (度)
ASIN
- ARCSIN
- 数値のアークサインを返します。
- アークサインとは、そのサインが数値であるような角度のことです。
- 戻り値の角度は、-PI/2 ～ PI/2 の範囲のラジアンとなります。
- 書式
  - ASIN(数値)
  - 数値求める角度のサインの値を、-1 ～ 1 の範囲で指定します。
  - アークサインの値を度で表すには、計算結果に 180/PI() を掛けます。
  - 使用例
    - ASIN(-0.5) = -0.5236 (-PI/6 ラジアン)
    - ASIN(-0.5)*180/PI() = -30 (度)
ATAN
- ARCTAN
- 数値のアークタンジェントを返します。
- アークタンジェントとは、そのタンジェントが数値であるような角度のことです。
- 戻り値の角度は、-PI/2 ～ PI/2 の範囲のラジアンとなります。
- 書式
  - ATAN(数値)
  - 数値求める角度のタンジェントの値を指定します。
  - アークタンジェントの値を度で表すには、計算結果に 180/PI() を掛けます。
  - 使用例
    - ATAN(1) = 0.785398 (PI/4 ラジアン)
    - ATAN(1)*180/PI() = 45 (度)
ATAN2
- 指定された x-y 座標のアークタンジェントを返します。
- アークタンジェントとは、x 軸から、原点 0 と x座標、y座標で表される点を結んだ直線までの角度のことです。
- 戻り値の角度は、-PI ～ PI (ただし -PI を除く) の範囲のラジアンとなります。
- 書式
  - ATAN2(x座標, y座標)
  - x座標, 点の x 座標を指定します。
  - y座標, 点の y 座標を指定します。
  - 戻り値が正の数なら x 軸から反時計回りの角度を表し、負の数なら x 軸から時計回りの角度を表します。
  - ATAN2(a,b) = ATAN(b/a) という関係になりますが、ATAN2 関数では、a に 0 を指定することができます。
  - x座標と y座標が両方とも 0 である場合、エラー値 #DIV/0 が返されます。
  - アークタンジェントの値を度で表すには、計算結果に 180/PI() を掛けます。
  - 使用例
    - ATAN2(1, 1) = 0.785398 (PI/4 ラジアン)
    - ATAN2(-1, -1) = -2.35619 (-3*PI/4 ラジアン)
    - ATAN2(-1, -1)*180/PI() = -135 (度)

表記方法

関数の記号の右上に「−1」を付ける
アークコサイン	cos	-1

アークサイン	sin	-1

アークタンジェント	tan	-1

もっと判り易くエクセルで説明


	A	B	C
1	角度	90	説明
2	RADIANS	1.570796327	ラジアンを求める
3	Cosine(x座標)	6.12574E-17
4	Sine(y座標)	1
5	Tangent(z座標)	1.63246E+16	( = y / x )
6	ARCCosine(角度)	90
7	ARCSine(角度)	90
8	ARCTangent(角度)	90	( = y / x )

上記はピタゴラスの定理：1章-2D編-図解で使ったものに数式を追加したものです。
又上記はエクセルのに数式を入れ表示された値をそのまま写したものです。
下記はその数式を写しました。
黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください

角度	90	説明
RADIANS	=RADIANS(B1)	ラジアンを求める
Cosine(x座標)	=COS(B2)
Sine(y座標)	=SIN(B2)
Tangent(z座標)	=TAN(B2)	( = y / x )
ARCCosine(角度)	=DEGREES(ACOS(B3))
ARCSine(角度)	=DEGREES(ASIN(B4))
ARCTangent(角度)	=DEGREES(ATAN(B5))	( = y / x )

セル「B1」の値(現在は「90」が入力されています)を変えてみて下さい。

応用をしてみます。

三角関数が判れば逆三角関数の「アーク」はもっと簡単です。
前章のピタゴラスの定理：2章-2D編-図解の応用からです。
直角三角形3種類の１つ∠角と１つの辺で残りの辺を求める式です。
「三角関数を使う」という条件です。※算出方法は他にもあります。
エクセルサンプルで説明します。

赤い部分が判っているところで青い部分が判らない箇所です。
黄色は∟（直角90度）です。
∠Aは「56.3」です。
辺zは「18.02775638」です。
「辺y」及び「辺x」を求める。

黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。

引数角度	56.3	∠A
RADIANS	=RADIANS(B1)	ラジアン
引数正接	18.02775638	正接z
Sine	=B3*SIN(B2)	正弦y
Cosine	=B3*COS(B2)	余弦x

赤い部分が判っているところで青い部分が判らない箇所です。
黄色は∟（直角90度）です。
∠Aは「56.3」です。
辺xは「10.0026001668331」です。
「辺y」及び「辺z」を求める。

黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。

引数角度	56.3	∠A
RADIANS	=RADIANS(B1)	ラジアン
引数余弦	10.0026001668331	余弦x
Cosine	=B3/COS(B2)	正接z
Tangent	=B3*TAN(B2)	正弦y

赤い部分が判っているところで青い部分が判らない箇所です。
黄色は∟（直角90度）です。
∠Aは「56.3」です。
辺zは「14.9982662331051」です。
「辺x」及び「辺z」を求める。

黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。

引数角度	56.3	∠A
RADIANS	=RADIANS(B1)	ラジアン
引数正弦	14.9982662331051	正弦y
Sine	=B3/SIN(B2)	正接z
Tangent	=B3/TAN(B2)	余弦x

角度をアークで求めます

いよいよアークです。
「三角関数を使う」という条件です。※算出方法は他にもあります。
エクセルでのサンプルです。

赤い部分が判っているところで青い部分が判らない箇所です。
黄色は∟（直角90度）です。
辺yは「14.9982662331051」です。
辺zは「18.02775638」です。
「∠A角度」及び「辺x」を求める。
ヒントは前項のピタゴラスの定理：2章-2D編-図解での
縦位置（Y座標・正弦）÷斜位置（Z座標・正接）＝Sine（サイン・正弦）。
縦位置（Y座標・正弦）と斜位置（Z座標・正接）が判っているのでARCSine（サイン・正弦）を使う。

黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。

引数正弦	14.9982662331051	正弦y
引数正接	18.02775638	正接z
ARCSine	=ASIN(B1/B2)	ラジアン
DEGREES	=DEGREES(B3)	ディグリー
Cosine	=B2*COS(RADIANS(B4))	余弦x
Tangent	=B1/TAN(RADIANS(B4))	余弦x

赤い部分が判っているところで青い部分が判らない箇所です。
黄色は∟（直角90度）です。
辺xは「10.0026001668331」です。
辺zは「18.02775638」です。
「∠A角度」及び「辺y」を求める。
ヒントは前項のピタゴラスの定理：2章-2D編-図解での
横位置（X座標・余弦）÷斜位置（Z座標・正接）＝Cosine（コサイン・余弦）。
横位置（X座標・余弦）と斜位置（Z座標・正接）が判っているのでARCCosine（コサイン・余弦）を使う

黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。

引数余弦	10.0026001668331	余弦x
引数正接	18.02775638	正接z
ARCCosine	=ACOS(B1/B2)	ラジアン
DEGREES	=DEGREES(B3)	ディグリー
Tangent	=B1*TAN(RADIANS(B4))	正弦y
Sine	=B2*SIN(RADIANS(B4))	正弦y

赤い部分が判っているところで青い部分が判らない箇所です。
黄色は∟（直角90度）です。
辺xは「10.0026001668331」です。
辺yは「14.9982662331051」です。
「∠A角度」及び「辺z」を求める。
ヒントは前項のピタゴラスの定理：2章-2D編-図解での
縦位置（Y座標・正弦）÷横位置（X座標・余弦）＝Tangent（タンジェント・正接）。
縦位置（Y座標・正弦）と横位置（X座標・余弦）が判っているのでARCTangent（タンジェント・正接）を使う

黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください。

引数余弦	10.0026001668331	余弦x
引数正弦	14.9982662331051	正弦y
ARCTangent	=ATAN(B2/B1)	ラジアン
DEGREES	=DEGREES(B3)	ディグリー
Sine	=B2/SIN(RADIANS(B4))	正接z
Cosine	=B1/COS(RADIANS(B4))	正接z

三角関数

三角関数は日常様々なところで使われています。地図・海図・軌跡・電波・建設など、特にPCでお仕事をされている方(CAD・製図・図形・音・ゲーム・グラフィック・プログラミング）には必須関数ともいえます。
英名 Trigonometric Function
総称して三角関数とは
1.ある線の長さを1とします。
2.その線をある角度の方向に描いた場合
3.線の先端がどの位置に置かれるのかを算出するものです。
ある角度（図の青色）をTheta(シータθ)と言います。
正弦・余弦・正接とは
線の先端の縦位置（Y座標）をSine（サイン・正弦）。
線の先端の横位置（X座標）をCosine（コサイン・余弦）。
線の先端の斜位置（Z座標）をTangent（タンジェント・正接）。
正確に定義で言えば
- 縦位置（Y座標・正弦）÷斜位置（Z座標・正接）＝Sine（サイン・正弦）。
- 横位置（X座標・余弦）÷斜位置（Z座標・正接）＝Cosine（コサイン・余弦）。
- 縦位置（Y座標・正弦）÷横位置（X座標・余弦）＝Tangent（タンジェント・正接）。
Tangent（タンジェント/正接）は Sine÷Cosineです。
当然、Theta（図の青色[シータθ]）が0度の場合は線（上左図の赤線）は真右です。
Theta（図の青色[シータθ]）が増すと反時計回り(正方向)に上昇します。
Theta（図の青色[シータθ]）が90度ですと線（上左図の赤線）は真上になります。
①Sine（サイン/正弦）はエクセルですと「=SIN(値)」
②Cosine（コサイン/余弦）はエクセルですと「=COS(値)」
ピタゴラスの定理
- 幾何学的（きかがく）に直角三角形の斜辺の長さを c とし、他の辺の長さを a, b とした場合
- a²+b²=c²
- という関係が成立する。
ピタゴラスの定理から三角関数のSineとCosineは

sin2θ + cos2θ = 1

1=SQRT(SIN(180)^2+COS(180)^2)

1=SQRT(Sine(Theta)^2+Cosine(Theta)^2)

前述「ピタゴラスの定理：1章-平方根とラジアン-図解」のハガキの=SQRT( X^2 + Y^2 )と同じ意味です。

正接以外の正弦・余弦は変わる？

参考程度のこの項は読まなくてもＯＫです。

1.⇒

現在の正弦・余弦
赤を∠角
青を∠余角とする

2. ⇒

そのまま
裏返す
それを

3. ⇒

直角が右下になるように
傾きを変える

4. ⇒

すると
∠角と∠余角が逆転し
余り角に対しての
正弦・余弦の関係も逆転する。
正接（斜線）は変わらない。
三角形の内角の和は180度。
黄色の角は直角90度。
直角以外の角２つの和は90度。
よって２つの何れかの角度が判れば
もう一方の角度は判る。

三角関数のイメージ

図①

図②（①の拡大）

図③

図①を拡大したものが図②で青塗りが「シータθ」
黄塗りは直角90°になります。
横軸がSine(X座標)
縦軸がCosine(Y座標)
図③はオレンジ線が「0」として
青線がPＩ（つまり3.14159265358979）
緑線がPＩの半分でPＩ()÷2
赤線がPＩの1.5倍でPＩ()×1.5

もっと簡単に！

RA角は直角（直角三角形）。
三角形の内角の和は180度。
θの角度の大きさが定まれば、3辺の比も決まる。
つまり辺同士の比が判ります。
θは角度又はラジアン値です。
A-C間(横)をx
B-C間(縦)をy
A-B間(斜)をzとします。
xyzの3つ比の全ての組み合わせは、
以下になります。

6つ三角比の組み合わせ
基本の３つ
1	正弦せいげん	サイン	sineθ	=	y / z	縦/斜
2	余弦よげん	コサイン	cosineθ	=	x / z	横/斜
3	正接せいせつ	タンジェント	tangentθ	=	y / x	縦/横	=	縦/斜 / 横/斜

単に逆数なので無視しても良い(縦/斜→斜/縦)
4	余割よかつ	コセカント	cosecantθ	=	z / y	斜/縦	=	1 / 縦/斜
5	正割せいかつ	セカント	secantθ	=	z / x	斜/横	=	1 / 横/斜
6	余接よせつ	コタンジェント	cotangentθ	=	x / y	横/縦	=	1 / 縦/横

エクセルで確認してみる

	A	B	C
1	角度	56.3	説明
2	RADIANS	0.982620369	ラジアン値を求める
3	Cosine(x座標)	0.554844427
4	Sine(y座標)	0.831954122
5	Tangent(z座標)	1.499436745	(=y / x)

ラジアンはピタゴラスの定理：1章-平方根とラジアン-図解で説明済み。
上記はエクセルのに数式を入れ表示された値をそのまま写したものです。
下記はその数式を写しました。
黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください

角度	56.3	説明
RADIANS	=RADIANS(B1)	ラジアン値を求める
Cosine(x座標)	=COS(B2)
Sine(y座標)	=SIN(B2)
Tangent(z座標)	=TAN(B2)	(=y / x)

セル「B1」の値(現在は「56.3」が入力されています)を変えてみて下さい。
この算出数値は全て比です。

今度は長さを求めます

図は上と同じです。
黄色の角度は直角（直角三角形）です。
先ほどのA-B間（斜辺つまりz）の長さは「1」と仮定してありましたから（×「1」）は省略されてます。
シータθ（赤の塗りつぶし）角度とA-B間（斜辺つまりz）の長さが判ればA-C間（底辺x）の長さやB-C間（高さy）の長さが判ります。

エクセルで長さを求める

	A	B	C
1	角度	56.3	説明
2	長さ(z)	18.02775638
3	Cosine(x座標)	10.00260017	※1
4	Sine(y座標)	14.99826623	※2
5	Tangent(z座標)	27.03148034	(=y / x)

ラジアン値は数式に組み込まれてます。
上記はエクセルのに数式を入れ表示された値をそのまま写したものです。
下記はその数式を写しました。
黄色の部分を選択するかボタンを押してエクセルのセル「A1」に「貼り付け」てみてください

角度	56.3	説明
長さ(z)	18.02775638
Cosine(x座標)	=COS(RADIANS(B1))*B2
Sine(y座標)	=SIN(RADIANS(B1))*B2
Tangent(z座標)	=TAN(RADIANS(B1))*B2	(=y / x)

セル「B1」の値(現在は「56.3」が入力されています)を変えてみて下さい。
セル「B2」の値(現在は「18.02775638」が入力されています)を変えてみて下さい。
この算出数値は全て長さです。

要するに
引数に角度指定	「斜辺」を指定した場合	「斜辺」を指定しない場合
サイン	高さ	高さ÷斜辺（比）
コサイン	底辺	底辺÷斜辺（比）
タンジェント	高さ÷底辺	高さ÷底辺（比）

あれっ！ハガキのサイズと一致した。

※1と※2の数値を見てください。「10.00260017」と「14.99826623」！
そうです。ピタゴラスの定理：1章-平方根とラジアン-図解の冒頭のハガキのサイズと限りなく近い数値になりましたね。
先ほども申しましたがTangent（タンジェント/正接）は Sine÷Cosineです。
これで三角関数、”三兄弟”サイン・コサイン・タンジェントは判りました。
「実際に角辺の長さを計る」応用は後に説明します。

もう一つの"三角関数"アーク

サイン・コサイン・タンジェントの他にそれらの文字の頭に「アーク」が付加する、
アークサイン・アークコサイン・アークタンジェントがあります。
その他にも立体3Dバージョンもあります。
これらは次の章「ピタゴラスの定理：3章-アーク編」で説明いたします。

平方根

平方根の概要と必要性

三角関数を理解するためには先ず「平方根」を理解して下さい。
関数「平方根」は正の平方根（へいほうこん）を返します。
別名では二乗根（にじょうこん）、自乗根（じじょうこん）。
英名では「Square Root」(スクエア)
VBでは[sqr()]、エクセルで求めるならSQRT。
記号は√で表します。

平方根の記号

√a

読みはルートエー(a)、√は根号

はがき（葉書）を例に！

どのご家庭にも必ずある官製はがき、これを例にして平方根を説明します。

ハガキは横幅が約10cm、高さが15cmあります。
ハガキの赤線の長さを求めるにはどうすればよいでしょう？
答えは「18.02775638」cmになります。

求め方

横幅をX座標、高さをY座標をします。
X^2剰 (10cm×10cm) = 100
Y^2剰 (15cm×15cm) = 225
これを足し算します。100 + 225 = 325
エクセルならシート関数[=SQRT(325)]で答えがでます。
この関数「SQRT」が平方根です。
平方根はある数字が2剰と一致する数値です。
例えばある数字が「4」であれば「4 = 2 × 2」つまり、2^2剰です。
「9」であれば3、「16」であれば4です。この「2」「3」「4」の数値が平方根です。

平方根の求め方。「9」を例にしてみます。

回数	個々の数値					式
1	9	-	1	=	8	9 - 1 = 8
2	8	-	3	=	5	8 - 3 = 5
3	5	-	5	=	0	5 - 5 = 0
黄色の部分は１から始まる増加していく奇数です。基になる「9」から最初の奇数「1」を引きます。すると答えは「8」になります。この「8」が次の基になる数値です。今度は「8」から次の奇数「3」を引きます。これを答えが「0」になるまで続けます。回数は「3」回になります。これが平方根です。 √9と表します。

大きな数値の場合は？

回数	個々の数値					式
1	7	-	1	=	6	7-1=6
2	6	-	3	=	3	6-3=3
1	384	-	41	=	343	384-41=343
2	343	-	43	=	300	343-43=300
3	300	-	45	=	255	300-45=255
4	255	-	47	=	208	255-47=208
5	208	-	49	=	159	208-49=159
6	159	-	51	=	108	159-51=108
7	108	-	53	=	55	108-53=55
8	55	-	55	=	0	55-55=0
例えば「784」なような場合には、数値を分けて考えます。「784」の場合だと「7」と「84」に分けます。「7」から始めます。 2回で引けなくなりました。余りは「3」、それと「84」を結合した数値にします。「384」を基点として回数は新たに数えます。次に黄色の引く数値が変わります。最後の黄色の数値は「3」でしたから今度はその数値に3の次の数値の4(3+1=4)と1から始まる奇数を結合した数値「43」から始めます。「8」回で終わりました。最初の「7」の方は「2」回でしたから「28」になります。この様に筆算で求める方法を開平法と言います。

計算は大変ですよね！そこで関数を使います。

ハガキの
X~2剰 (10cm×10cm) = 100
Y~2剰 (15cm×15cm) = 225
二つを足すと100 + 225 = 325になります。
関数を使う場合は式を入れます。
=SQRT( X^2 + Y^2 )
スクエアと読みます。
答えは「18.02775638」cmになります。

ひとよひとよにひとみごろ（一夜一夜に人見頃）

「いい国つくろう鎌倉幕府(現在は1185年説もあり)」は歴史年号ですが語呂合わせ数学バージョンにもあります。
1～10の整数に限って言えば平方数の1と4と9以外の数値の平方根は整数にはなりません。
1と4と9を除く数値の平方根は円周率の「3.14・・・・」のような終わりのない数値になります（無理数という）。

√1	1	整数
√2	1.414213562	一夜一夜に人見頃（ひとよひとよにひとみごろ）
√3	1.732050808	人並みに奢れや女子（ひとなみにおごれやおなご）
√4	2	整数
√5	2.236067977	富士山麓鸚鵡鳴く（ふじさんろくおーむなく）
√6	2.449489743	ツヨシ串焼くな（つよしくしやくな）
√7	2.645751311	菜に虫いない（なにむしいない）
√8	2.828427125	ニヤニヤ呼ぶな（にやにやよぶな）
√9	3	整数
√10	3.16227766	父さん一郎兄さん（とうさんいちろーにーさん）

平方根のイメージ

長さ=斜辺

ラジアン角

ラジアンとディグリー（角度）を覚えないと三角関数は判りません。

キーワードは円周率

ラジアンの値は近似値。
角度を数値にしたものです。
PI()=3.14159265358979 つまり円周率です。
エクセルでは「=PI()」で求められます。

円周率はPIで示す。

円周率は英語でPi

PI()=3.14159265358979
PI()*2=	6.283185307
PI()=	3.141592654
PI()/2=	1.570796327
PI()/4=	0.785398163
PI()/8=	0.392699082

ラジアンRADと度DEGの関係

PI()=3.14159265358979(ラジアン)
数式(参照元[ラジアン])	答え(ディグリー)	(ラジアン)答え	数式(参照元[ディグリー])
=DEGREES(PI()*2)	360	6.283185307	=RADIANS(360)
=DEGREES(PI())	180	3.141592654	=RADIANS(180)
=DEGREES(PI()/2)	* 90	1.570796327 *	=RADIANS(90)
=DEGREES(PI()/4)	45	0.785398163	=RADIANS(45)
=DEGREES(PI()/8)	22.5	0.392699082	=RADIANS(22.5)

ラジアンで表された角度を度に変更します。
- DEGREES(角度) / ディグリー
- 使用例　DEGREES(PI()) = 180
- 上の表* 「1.570796327」ディグリー = 90度になります。
- 関数使用ではDEGREES(1.570796327) = 90
度単位で表された角度をラジアンに変換した結果を返します。
- RADIANS(角度) / ラジアン
- 使用例　RADIANS(270) = 4.712389 (3π/2 ラジアン)
- 上の表* 「90」ラジアン = 1.570796327 になります。
- 関数使用ではRADIANS(90) = 1.570796327

InStr 関数

バリアント型 (内部処理形式 Long の Variant) の値を返します。ある文字列 (string1) の中から指定した文字列 (string2) を検索し、最初に見つかった文字位置 (先頭からその位置までの文字数) を返す文字列処理関数です。

構文
InStr([start, ]string1, string2[, compare])
Instr 関数の構文は、次の引数から構成されます。
指定項目内容
start
省略可能です。検索の開始位置を表す数式を指定します。省略すると、先頭の文字から検索されます。引数 start に Null 値が含まれている場合、エラーが発生します。引数 compare を指定した場合は、start も指定する必要があります。
string1
必ず指定します。検索対象となる文字列式を指定します。
string2
必ず指定します。引数 string1 内で検索する文字列式を指定します。
compare
省略可能です。文字列比較の比較モードを指定する番号を設定します。引数 compare が Null 値の場合は、エラーが発生します。引数 compare を指定した場合は、引数 start も指定する必要があります。引数 compare を省略すると、Option Compare ステートメントの設定に応じて、比較モードが決まります。ローカル固有の比較ルールを使用するには、有効なLCID (LocaleID) を指定します。
設定値
引数 compare
の設定値は次のとおりです。
定数値説明

定数	値	説明
vbUseCompareOption	-1	OptionCompareステートメントの設定を使用して比較を行います。
vbBinaryCompare	0	バイナリモードの比較を行います。
vbTextCompare	1	テキストモードの比較を行います。
vbDatabaseCompare	2	MicrosoftAccessの場合のみ有効。データベースに格納されている設定に基づいて比較を行います。

戻り値

内容	値
string1 が長さ 0 の文字列 (") のとき	0
string1 が Null 値のとき	Null 値
string2 が長さ 0 の文字列 (") のとき	start
string2 が Null 値のとき	Null 値
string2 が見つからないとき	0
string2 が string1 内で見つかったとき	見つかった文字列の位置
start の値が string1 の文字数を超えるとき	0

解説
文字列をバイトデータとして扱う場合は、InStrB 関数を使用します。InStrB 関数は検索結果をバイト位置 (先頭からその位置までのバイト数) で返します。

InStr 関数の使用例
次の例は、InStr 関数を使って、ある文字列の中から指定した文字列を検索し、最初に見つかった位置を返します。

Option Explicit

Dim SearchString, SearchChar, MyPos
SearchString = "XXpXXpXXPXXP"           ' 検索対象の文字列を定義します。
SearchChar = "P"                        ' "P" を検索します。

' 文字単位の比較を位置 4 から開始すると、6 が返されます。
MyPos = InStr(4, SearchString, SearchChar, 1)

' ビット単位の比較を位置 1 から開始すると、9 が返されます。
MyPos = InStr(1, SearchString, SearchChar, 0)

' 既定のビット単位の比較を行います(最後の引数を省略した場合)。
MyPos = InStr(SearchString, SearchChar)    ' 9 を返します。

MyPos = InStr(1, SearchString, "W")        ' 0 を返します。

'<モードの違い>
'┌─────────┬───┬────┬────┐
'│内容              │例    │バイナリ│テキスト│
'├─────────┼───┼────┼────┤
'│大文字/小文字     │A/a   │異      │同      │
'│全角/半角         │Ａ/A  │異      │同      │
'│ひらがな/カタカナ │あ/ア │異      │同      │
'└─────────┴───┴────┴────┘

InStrRev 関数

ある文字列 (string1) の中から指定された文字列 (string2) を最後の文字位置から検索を開始し、最初に見つかった文字位置 (先頭からその位置までの文字数) を返す文字列処理関数です。

構文
InstrRev(stringcheck, stringmatch[, start[, compare]])
InstrRev 関数の構文は、次の名前付き引数から構成されます。
指定項目説明
stringcheck
必ず指定します。検索先の文字列式を指定します。
stringmatch
必ず指定します。検索する文字列式を指定します。
start
省略可能です。各検索の開始位置を設定する数式を指定します。引数 start を省略すると -1 が使用され、最後の文字位置から検索を開始します。引数 start に Null 値が含まれると、エラーになります。
compare
省略可能です。文字列式を評価するときに使用する文字列比較のモードを表す数値を指定します。引数 compare を省略すると、バイナリモードで比較が行われます。設定する値については、次の「設定値」を参照してください。
設定値
引数 compare の設定値は次のとおりです。
定数値説明

定数	値	説明
vbUseCompareOption	-1	OptionCompareステートメントの設定を使用して比較を行います。
vbBinaryCompare	0	バイナリモードの比較を行います。
vbTextCompare	1	テキストモードの比較を行います。
vbDatabaseCompare	2	MicrosoftAccessの場合のみ有効。データベースに格納されている設定に基づいて比較を行います。

戻り値
InStrRev 関数の戻り値は次のとおりです。

内容	値
string1 が長さ 0 の文字列 (") のとき	0
string1 が Null 値のとき	Null 値
string2 が長さ 0 の文字列 (") のとき	start
string2 が Null 値のとき	Null 値
string2 が見つからないとき	0
string2 が string1 内で見つかったとき	見つかった文字列の位置
start の値が string1 の文字数を超えるとき	0

解説
InstrRev関数の構文は、Instr関数の構文とは異なります。

文字操作指定文字列を最後から検索した文字を２分割する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'最後から検索

Function FirstStrSearchLast(str As String, searchStr As String)
'*********************************************
'指定文字列を最後から検索した文字を２分割する
'*********************************************
'返値：最初（左）の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStrRev(str, searchStr)
FirstStr = Left(str, i - 1)
LastStr = Mid(str, i + 1)
FirstStrSearchLast = FirstStr
Exit Function
ErrEnd:
FirstStrSearchLast = ""
End Function

Function LastStrSearchLast(str As String, searchStr As String)
'*********************************************
'指定文字列を最後から検索した文字を２分割する
'*********************************************
'返値：最後（右）の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStrRev(str, searchStr)
FirstStr = Left(str, i)
LastStr = Mid(str, i + 1)
LastStrSearchLast = LastStr
Exit Function
ErrEnd:
LastStrSearchLast = ""
End Function

'最初から検索

Function FirstStrSearchFirst(str As String, searchStr As String)
'*********************************************
'指定文字列を最初から検索した文字を２分割する
'*********************************************
'返値：最初（左）の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStr(str, searchStr)
FirstStr = Left(str, i - 1)
LastStr = Mid(str, i + 1)
FirstStrSearchFirst = FirstStr
Exit Function
ErrEnd:
FirstStrSearchFirst = ""
End Function

Function LastStrSearchFirst(str As String, searchStr As String)
'*********************************************
'指定文字列を最初から検索した文字を２分割する
'*********************************************
'返値：最後（右）の文字が返ります。
Dim FirstStr As String, LastStr As String, i As Long
If InStr(1, str, searchStr) = 0 Then GoTo ErrEnd:
i = InStr(str, searchStr)
FirstStr = Left(str, i)
LastStr = Mid(str, i + 1)
LastStrSearchFirst = LastStr
Exit Function
ErrEnd:
LastStrSearchFirst = ""
End Function

Private Sub test()
Dim strTest As String, SearChTest As String
    strTest = "本日は晴天なり"
    SearChTest = " "
    Debug.Print FirstStrSearchLast(strTest, SearChTest)     '本日は晴天
    Debug.Print LastStrSearchLast(strTest, SearChTest)      'なり
    Debug.Print FirstStrSearchFirst(strTest, SearChTest)    '本日
    Debug.Print LastStrSearchFirst(strTest, SearChTest)     'は晴天なり
    strTest = "本日-は-晴天-なり"
    SearChTest = "-"
    Debug.Print FirstStrSearchLast(strTest, SearChTest)     '本日は晴天
    Debug.Print LastStrSearchLast(strTest, SearChTest)      'なり
    Debug.Print FirstStrSearchFirst(strTest, SearChTest)    '本日
    Debug.Print LastStrSearchFirst(strTest, SearChTest)     'は晴天なり
End Sub

'参考

Function GetFileName(strPath As String)
'*********************************
'パス文字列からファイル名だけ検出
'*********************************
'パスらしくない場合は空白を返す
'パスは最後の\を除く
Dim Pth As String, Fl As String
If InStr(1, strPath, ".") = 0 Then GoTo ErrEnd:
If InStr(1, strPath, "\") = 0 Then GoTo ErrEnd:
Fl = Dir(strPath)
Pth = Replace(strPath, Fl, "")
Pth = Mid(Pth, 1, Len(Pth) - 1)
GetFileName = Fl
Exit Function
ErrEnd:
GetFileName = ""
End Function

Function GetPathName(strPath As String)
'*********************************
'パス文字列からパスだけ検出
'*********************************
'パスらしくない場合は空白を返す
'パスは最後の\を除く
Dim Pth As String, Fl As String
If InStr(1, strPath, ".") = 0 Then GoTo ErrEnd:
If InStr(1, strPath, "\") = 0 Then GoTo ErrEnd:
Fl = Dir(strPath)
Pth = Replace(strPath, Fl, "")
Pth = Mid(Pth, 1, Len(Pth) - 1)
GetPathName = Pth
Exit Function
ErrEnd:
GetPathName = ""
End Function

Private Sub testg()
Dim strTest As String
strTest = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Debug.Print GetFileName(strTest)
Debug.Print GetPathName(strTest)
End Sub

文字操作文字空白削除と禁止有無

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub 文字空白削除と禁止有無()
'*******************************************************************************
'文字空白削除と禁止有無
'*******************************************************************************
Dim sht As Worksheet, a As Long, b As Long, c As Long, d As String, e As String

Set sht = ThisWorkbook.Worksheets("Sheet2")

With sht
    b = Fnc最終行(sht)
    For a = 1 To b
        For c = 1 To 16
            d = .Cells(a, c).Value
            e = Fnc文字内空白(d)
            .Cells(a, c).Value = e
            If Fnc文字内禁止有無(e) = False Then
            MsgBox e, vbCritical, "ERRR "
            End If
        Next c
    Next a
End With

End Sub

文字操作文字を全角から半角にする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

文字操作文字中の指定文字と指定文字間の文字を全て検索

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub SearchAllLettersBetween(str As String, strFoundFront As String, strFoundBack As String)
'************************************************
'文字中の指定文字と指定文字間の文字を全て検索
'************************************************
'引数strは対象文字群
'引数strFoundFrontは前方検索対象文字
'引数strFoundBackは後方検索対象文字

'＜例＞
'str = "zyzyzyzabc="def"zyzyzyzabc="ghij"zyz"
'strFoundFront = "abc="
'strFoundBack = """"
'返値は [abc="def"] と[abc="ghij"]　になります。

'＜解説＞
'Replace関数で一度検索したものは全て消すところがミソ！
'検索文字がなくなるまで実行します。
'書き出したい場合は[Debug.Print Xa]の個所を改変してください。

Dim i As Long, Xa As String, Xb As Long

reTRY: '再帰①
i = InStr(1, str, strFoundFront) '前方検索対象文字位置
If i = 0 Then GoTo TheEnd: '無ければ終了②
Xb = InStr(i + Len(strFoundFront) + 1, str, strFoundBack) '後方検索対象文字位置
Xa = Mid(str, i, Xb - i + 1) '値をゲット
Debug.Print Xa
str = Replace(str, Xa, "") 'ゲット後は削除する(対象文字群内全て)

GoTo reTRY: '再帰①
TheEnd: '無ければ終了②
End Sub

文字操作 OpenTextメソッド

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

OpenText メソッド

テキストファイルを分析して読み込みます。テキストファイルを 1 枚のシートとして、それを含む新しいブックを開きます。

構文
expression.OpenText(Filename, Origin, StartRow, DataType, TextQualifier, ConsecutiveDelimiter, Tab, Semicolon, Comma, Space, Other, OtherChar, FieldInfo, DecimalSeparator, ThousandsSeparator)
expression
必ず指定します。対象となる Workbooks コレクションを表すオブジェクト式を指定します。
Filename
必ず指定します。文字列型 (String) の値を使用します。読み込まれるテキストファイルの名前を指定します。
Origin
省略可能です。バリアント型 (Variant) の値を使用します。テキストファイルが作成された機種を指定します。使用できる定数は、XlPlatform クラスの xlMacintosh、xlWindows、xlMSDOS のいずれかです。この引数を省略すると、現在のテキストファイルウィザードを使用している機種が指定されます。
StartRow
省略可能です。バリアント型 (Variant) の値を使用します。取り込む開始行を指定します。最初の行を 1 として数えます。既定値は 1 です。
DataType
省略可能です。バリアント型 (Variant) の値を使用します。ファイルに含まれるデータの形式を指定します。使用できる定数は、XlTextParsingType クラスの xlDelimited または xlFixedWidth です。既定値は xlDelimited です。
TextQualifier
省略可能です。バリアント型 (Variant) の値を使用します。文字列の引用符を指定します。使用できる定数は、XlTextQualifier クラスの xlTextQualifierDoubleQuote、xlTextQualifierSingleQuote、xlTextQualifierNone です。既定値は xlTextQualifierDoubleQuote です。
ConsecutiveDelimiter
省略可能です。バリアント型 (Variant) の値を使用します。連続した区切り文字を 1 文字として扱うときは True を指定します。既定値は False です。
Tab
省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にタブを使うときは True を指定します。既定値は False です。
Semicolon
省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にセミコロン (;) を使うときは True を指定します。既定値は False です。
Comma
省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にカンマ (,) を使うときは True を指定します。既定値は False です。
Space
省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字にスペースを使うときは True を指定します。既定値は False です。
Other
省略可能です。バリアント型 (Variant) の値を使用します。引数 DataType に xlDelimited を指定し、区切り文字に OtherChar で指定した文字を使うときは True を指定します。既定値は False です。
OtherChar
省略可能です。バリアント型 (Variant) の値を使用します。引数 Other が True のときは、必ずこの引数に区切り文字を指定します。複数の文字を指定したときは、先頭の文字が区切り文字となり、残りの文字は無視されます。
FieldInfo
省略可能です。バリアント型 (Variant) の値を使用します。各列のデータ形式を示す配列を指定します。データ形式の解釈は、引数 DataType に指定された値によって異なります。
引数 DataType
が xlDelimited のとき (データが区切り文字で区切られているとき) は、この引数には 2 つの要素を持つ配列の配列を指定します。2 つの要素を持つ配列の 1 つずつが、各列の処理方法を決定します。1 番目の要素には 1 から始まる列の番号を指定し、2 番目の要素には各列の変換方法を指定する、次の xlColumnDataType クラスの定数のいずれかを指定します。

定数	内容
xlGeneralFormat	一般
xlTextFormat	テキスト
xlMDYFormat	MDY (月日年) 形式の日付
xlDMYFormat	DMY (日年月) 形式の日付
xlYMDFormat	YMD (年月日) 形式の日付
xlMYDFormat	MYD (月年日) 形式の日付
xlDYMFormat	DYM (日年月) 形式の日付
xlYDMFormat	YDM (年日月) 形式の日付
xlEMDFormat	EMD (台湾年月日) 形式の日付
xlSkipColumn	スキップ列

定数 xlEMDFormat
は、簡易字中国語サポートがインストールおよび選択されている場合にのみ使用できます。定数 xlEMDFormat は、日付形式に台湾の元号が使用されていることを指定します。
列の指定は
、どのような順番でもかまいません。指定されなかった列は、一般の形式だと解釈されます。次の例では、3 番目の列は削除され、最初の列は文字列として解釈され、残りの列は一般の形式として解釈されます。
Array(Array(3, 9), Array(1, 2))
引数 DataType
が xlFixedWidth のとき (データが固定長で区切られているとき)、配列の 1 番目の要素には、行のどの位置から処理が行われるかを 0 から始まる整数で指定します。2 番目の要素には変換方法を 1 ～ 9 の数値で指定します (上の対応表参照)。
次の例は、
固定長のテキストファイルから 2 つの列を読み込みます
。最初の列は行頭から 10 文字目までが入ります。11 文字目から 15 文字目まではスキップします。2 番目の列は 16 文字目から行の終わりまでとなります。
Array(Array(0, 1), Array(10, 9), Array(15, 1))
DecimalSeparator
省略可能です。文字列型 (String) の値を使用します。Excel で数値を認識する場合に使う小数点の記号です。既定はシステム設定です。
ThousandsSeparator
省略可能です。文字列型 (String) の値を使用します。Excel で数値を認識する場合に使う桁区切り記号でです。既定はシステム設定です。
さまざまなインポート設定
でテキストを Excel にインポートする結果を次に示します。数値の結果は右詰めで表示します。

システムの小数点の記号	システムの桁区切りの記号	小数点の記号の値	桁区切りの記号の値	インポートしたテキスト	セルの値 (データ型)
ピリオド	カンマ	カンマ	ピリオド	123.123,45	123,123.45 (数値)
ピリオド	カンマ	カンマ	カンマ	123.123,45	123.123,45 (文字列)
カンマ	ピリオド	カンマ	ピリオド	123123.45	123,123.45 (数値)
ピリオド	カンマ	ピリオド	カンマ	123 123.45	123 123.45 (文字列)
ピリオド	カンマ	ピリオド	スペース	123 123.45	123,123.45 (数値)

OpenText メソッドの使用例
次の使用例は、Data.txt というテキストファイルを、タブを区切り文字として分析し、ワークシートに変換します。

Option Explicit

Workbooks.OpenText Filename:="DATA.TXT", _
DataType:=xlDelimited, Tab:=True

文字操作 Len関数の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の例は、Len 関数を使って、文字列の文字数、または変数の保存に必要なバイト数を返します。CustomerRecord を定義する Type...End Type ブロックをクラスモジュール内で記述する場合、このブロックの直前にキーワード Private を付ける必要があります。標準モジュールでは、Type ステートメントでパブリックなユーザー定義型を定義できます。

Type CustomerRecord                ' ユーザー定義型を定義します。
    ID As Integer                    ' この定義は標準モジュール内に記述します。
    Name As String * 10
    Address As String * 30
End Type

Dim Customer As CustomerRecord        ' 変数を宣言します。
Dim MyInt As Integer, MyCur As Currency
Dim MyString, MyLen
MyString = "Hello World"            ' 変数を初期化します。
MyLen = Len(MyInt)                ' 2 を返します。
MyLen = Len(Customer)            ' 42 を返します。
MyLen = Len(MyString)            ' 11 を返します。
MyLen = Len(MyCur)                ' 8 を返します。

'次の例では、LenB 関数とユーザー定義関数 LenMbcs を使用して、指定した文字列のバイト数を返します。32 ビット Windows 用の VBA を使用する場合と、Macintosh用の VBA を使用する場合とでは、返される結果が異なる点に注意してください。

Function LenMbcs(ByVal str As String)
    LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

Dim MyString, MyLen
MyString = "ＡＢc"
' "Ａ" と "Ｂ" は全角文字で "c" は半角文字です。
MyLen = Len(MyString)
' 文字数として 3 が返されます。
MyLen = LenB(MyString)
' Windows の場合は 6、Macintosh の場合には 5 がバイト数として返されます。
MyLen = LenMbcs(MyString)
' Windows の場合は 5 が返されます。Macintosh の場合は
' Unicode がサポートされていないため、エラーが返されます。

文字操作 Like演算子で英語数字漢字ひらがなカタカナを判別する文字列をキーワード毎に分ける

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Function LetterNo(letter As String) As Byte
'****************************************************
'Like演算子で英語数字漢字ひらがなカタカナを判別する
'****************************************************
'英語[1]・数字[2]・漢字[3]
'全角ひらがな大[4]・全角ひらがな小[4]
'全角カタカナ大[5]・全角カタカナ小[5]
'長音ー[0]・その他[6]を返す
'※引数letterには１文字だけ
'※返り値はバイト数
'※長音[ー]で始まるひらがなカタカナは無いとみなす。
'※特殊文字は対象外[6]する

If letter = "_" Then LetterNo = 6: Exit Function
If letter Like "[A-Z]" = True Then LetterNo = 1: Exit Function
If letter Like "[a-z]" = True Then LetterNo = 1: Exit Function
If letter Like "[Ａ-ｚ]" = True Then LetterNo = 1: Exit Function
If letter Like "[0-9]" = True Then LetterNo = 2: Exit Function
If letter Like "[０-９]" = True Then LetterNo = 2: Exit Function
If letter Like "[一－龠]" = True Then LetterNo = 3: Exit Function
If letter Like "[あ-ん]" = True Then LetterNo = 4: Exit Function
If letter Like "[ア-ン]" = True Then LetterNo = 5: Exit Function
If letter = "ー" Then LetterNo = 0: Exit Function

LetterNo = 6

End Function

Function LetterKeyword(LongLetter As String)
'****************************************************
'文字列をキーワード毎に分ける
'****************************************************
'※特殊文字は除外する
'※１文字は除外する
Dim i As Long
Dim NowNumber As Byte       '現在番号
Dim FncNo As Byte           '関数から得た番号
Dim PreviousNumber As Byte  '前の番号
Dim MemoryNumber As Byte    '記憶番号
Dim ExclusionNumber As Byte '除外番号
Dim TmpLetter As String     '仮の文字
Dim Character As String     '処理中の１文字
Dim Spl As Variant

PreviousNumber = 9: MemoryNumber = 9 '初期化
ExclusionNumber = 9                  '初期化
    For i = 1 To Len(LongLetter)
        Character = Mid(LongLetter, i, 1)
        FncNo = LetterNo(Character) 'Function LetterNo
            '長音[ー]処理
            If FncNo = 0 Then
                NowNumber = MemoryNumber
            ElseIf FncNo = 6 Then
                ExclusionNumber = ExclusionNumber + 1
                NowNumber = ExclusionNumber
                MemoryNumber = ExclusionNumber
            Else
                NowNumber = FncNo
                MemoryNumber = FncNo
            End If
            '区切り処理
            If NowNumber <> PreviousNumber Then
                TmpLetter = TmpLetter & "," & Character
                PreviousNumber = NowNumber
            Else
                TmpLetter = TmpLetter & Character
            End If
    Next i
Spl = Split(TmpLetter, ",")
TmpLetter = "" '初期化
    For i = LBound(Spl) To UBound(Spl)
        '※１文字は除外する
        If Not Len(Spl(i)) <= 1 Then
            TmpLetter = TmpLetter & Spl(i) & ","
        End If
    Next i
LetterKeyword = TmpLetter
End Function

Private Sub test()
Dim str As String
str = "XP_Office_2000/[XP]/2003用SP統合ソフト_SP+メーカーOffice_2000編"
MsgBox LetterKeyword(str)
Debug.Print LetterKeyword(str)
'XP,Office,2000,XP,2003,SP,統合,ソフト,SP,メーカー,Office,2000,
End Sub

文字操作 0～9・a～z・あ～ん・ア～ンのようなグループに属するか判断するLike演算子

文字操作 CSV形式テキストファイル出力

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub AddCSV()
'*******************************
'CSV形式テキストファイル出力
'*******************************
'フィールド名に「日」の文字を含む場合"yyyy/mm/dd"形式にする。
On Error GoTo error:

Dim sht(1 To 2) As Worksheet
Dim bok As Workbook
Dim MyPath As String
Dim MyPath2 As String
Dim i As Byte
Dim j As Long
Const shtFol As String = "\Backup"
Dim Fso As Object
Dim Chack As Boolean

Set bok = Workbooks("pdpData.xls")
Set sht(1) = bok.Worksheets("会計伝票")
Set sht(2) = bok.Worksheets("カルテ")

Application.ScreenUpdating = False

Set Fso = CreateObject("Scripting.FileSystemObject")

MyPath2 = bok.Path & shtFol

Chack = Fso.Folderexists(MyPath2)

If Chack = False Then   '無ければ作成
    Fso.createfolder (MyPath2)
End If

Set Fso = Nothing

MyPath = bok.Path & shtFol & "\"

For i = 1 To 2
    With sht(i)
    If Dir(MyPath & .Name & ".csv") <> "" Then Kill MyPath & .Name & ".csv"
        Application.DisplayAlerts = False
            For j = 1 To .Range("A1").SpecialCells(xlCellTypeLastCell).Column
                If InStr(1, .Cells(1, j).Value, "日") <> 0 Then
                    .Columns(j).NumberFormat = "yyyy/mm/dd"
                End If
            Next j
        .Copy
        ActiveWorkbook.SaveAs Filename:=MyPath & .Name & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True
    End With
    Set sht(i) = Nothing
Next i

Set bok = Nothing

MsgBox MyPath & "バックアップをしました", 0, "Ｂａｃｋｕｐ"

Exit Sub
error:
MyErrorMsg
End Sub

文字操作 0～9・a～z・あ～ん・ア～ンのようなグループに属するか判断するLike演算子

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Like 演算子

Like 演算子

2 つの文字列の比較を行います。

構文

result = string Like pattern Like

演算子の構文は、次の指定項目から構成されます。

指定項目	内容
result	必ず指定します。任意の数値変数を指定します。
string	必ず指定します。任意の文字列式を指定します。
pattern	必ず指定します。「解説」に示すパターンマッチング規則に従った任意の文字列式を指定します。

解説

文字列式 string と文字列式 pattern が一致していると、演算結果 result は真 (True) になります。一致していないときは、演算結果 result は偽 (False) になります。文字列式 string または文字列式 pattern のいずれかが Null 値のときは、演算結果 result も Null 値になります。

Like 演算子の動作は、Option Compare ステートメントの設定によって異なります。各モジュールに対する文字列比較の既定の方法は、Option Compare Binary ステートメントの設定が使われます。

Option Compare Binary ステートメントでは、文字列比較で使われる並べ替え順序は、バイナリ文字コードのコード順によって決まります。並べ替えのコード順としては、シフト JIS コードが使用されます。バイナリモード (Binary) での並べ替え順序の例を次に示します。

A < B < E < Z < a < b < e < z < A < E < O < a < e < o

Option Compare Text ステートメントでは、文字列比較は、オペレーティングシステムの国別情報によって決まり、日本語の場合は 50 音順およびアルファベット順で、大文字小文字を区別しない並べ替え順序になります。清音や濁音は、清音、濁音、半濁音の順序で並べ替えられます。テキストモード (Text) での並べ替え順序の例を次に示します。

(*=＊) < (0=０) < (9=９) < (A=a=Ａ=ａ) < (B=b=Ｂ=ｂ) < (ｱ=ア=あ) < (ﾝ=ン=ん) < 亜

組み込みのパターンマッチング機能では、文字列比較のための便利な機能を利用できます。ワイルドカード、文字リスト、文字範囲などを組み合わせて使用できます。次に文字列式 pattern に指定できる文字と、一致する文字を示します。

文字パターン	引数 string の中の一致する文字
?	任意の 1 文字
*	任意の数の文字
#	任意の 1 文字の数字 (0-9)
[charlist]	文字リスト charlist に指定した文字の中の任意の 1 文字
[!charlist]	文字リスト charlist に指定した文字以外の任意の 1 文字

これらのうち、"#" を除くすべての文字パターンでは、2 バイト文字 (全角文字) も 1 文字と数えて文字列比較を行います。"#" には、1 バイト (半角) の数字だけが一致します。1 個以上の文字のリスト (charlist) を角かっこ ([ ]) で囲んで文字列式 pattern に指定すると、その中のいずれかの文字と、文字列式 string の中の該当する 1 文字が一致するかどうかを比較することができます。角かっこ ([ ]) の中の文字リストには、数字も含め、文字コードおよびシフト JIS コードのほぼすべての文字を指定できます。

サンプルコード
Dim MyCheck MyCheck = letter Like "[A-Z]" Debug.Print MyCheck MyCheck = letter Like "[a-z]" Debug.Print MyCheck MyCheck = letter Like "[A-z]" Debug.Print MyCheck MyCheck = letter Like "[Ａ-Ｚ]" Debug.Print MyCheck MyCheck = letter Like "[ａ-ｚ]" Debug.Print MyCheck MyCheck = letter Like "[Ａ-ｚ]" Debug.Print MyCheck MyCheck = letter Like "[0-9]" Debug.Print MyCheck MyCheck = letter Like "[０-９]" Debug.Print MyCheck MyCheck = letter Like "[一－龠]" Debug.Print MyCheck MyCheck = letter Like "[あ-ん]" Debug.Print MyCheck MyCheck = letter Like "[ぁ-ゎ]" Debug.Print MyCheck MyCheck = letter Like "[あ-ゎ]" Debug.Print MyCheck MyCheck = letter Like "[ア-ン]" Debug.Print MyCheck MyCheck = letter Like "[ァ-ヮ]" Debug.Print MyCheck MyCheck = letter Like "[ア-ヮ]" Debug.Print MyCheck
True=1 False=0	英語				数値		漢字	ひらがな		カタカナ
	半角		全角		半角	全角	全角	全角		全角
	大	小	大	小	半角	全角	全角	大	小	大	小
	F	f	Ｆ	ｓ	0	０	亞	ふ	ぉ	フ	ォ
[A-Z]	1	0	0	0	0	0	0	0	0	0	0
[a-z]	0	1	0	0	0	0	0	0	0	0	0
[A-z]	1	1	0	0	0	0	0	0	0	0	0
[Ａ-Ｚ]	0	0	1	0	0	0	0	0	0	0	0
[ａ-ｚ]	0	0	0	1	0	0	0	0	0	0	0
[Ａ-ｚ]	0	0	1	1	0	0	0	0	0	0	0
[0-9]	0	0	0	0	1	0	0	0	0	0	0
[０-９]	0	0	0	0	0	1	0	0	0	0	0
[一－龠]	0	0	0	0	0	0	1	0	0	0	0
[あ-ん]	0	0	0	0	0	0	0	1	1	0	0
[ぁ-ゎ]	0	0	0	0	0	0	0	1	1	0	0
[あ-ゎ]	0	0	0	0	0	0	0	1	1	0	0
[ア-ン]	0	0	0	0	0	0	0	0	0	1	1
[ァ-ヮ]	0	0	0	0	0	0	0	0	0	1	1
[ア-ヮ]	0	0	0	0	0	0	0	0	0	1	1

メモ

特殊文字の左角かっこ ([)、疑問符 (?)、数値記号 (#)、およびアスタリスク (*) を文字列比較するには、これらの文字を角かっこで囲みます。右角かっこ (]) をワイルドカードとしてではなくその文字自体として文字列比較を行うときには、右角かっこを他の文字と共に角かっこで囲んでリストの中に指定することはできません。右角かっこは、文字のリストに入れずに単独で指定すると、独立した文字として、文字列の中の文字と比較できます。

角かっこの中に指定する文字リスト charlist には、文字コードの並びの上限と下限をハイフン (-) で区切ることによって、特定の文字範囲を指定することもできます。2 バイト文字も範囲指定でき、漢字の範囲の指定もできます。たとえば、[A-Z] と指定すると、大文字の A から Z までの文字をすべてリストの中に指定したときと同じ意味になり、文字列式 string の中の対応する位置の文字が大文字のアルファベットのいずれか 1 文字であるときに一致します。1 組の角かっこの中に複数の範囲を指定するときは、それぞれの範囲の間を区切らずに記述します。

指定した範囲の意味は、Option Compare ステートメントの設定と、実行時のオペレーティングシステムの国別情報の設定によって異なります。Option Compare Binary ステートメントの例では、[A-E] の範囲を指定すると、A、B および E が一致します。Option Compare Text ステートメントでは、[A-E] の範囲を指定すると、A、a、A、a、B、b、E、および e が一致します。この範囲を指定すると、E または e と一致しません。並べ替え順序では、アクセント記号付きの文字はアクセント記号の付いていない文字の後になります。

パターンマッチングに関するその他の主な規則

文字リスト charlist の先頭に感嘆符 (!) を指定すると、文字列 string の中の文字が文字リスト charlist に指定した文字以外のときに、一致することを表します。角かっこの外に指定した感嘆符は、文字としての感嘆符と一致します。

ハイフン (-) を文字リスト charlist の先頭 (感嘆符が使われているときはその直後) または charlist の末尾に指定したときは、文字としてのハイフンと一致します。それ以外の位置に指定したハイフンは、ASCII コードおよびシフト JIS コードの文字の範囲を表します。

文字の範囲を指定するとき、文字の順序は昇順 (低い方から高い方へ) でなければなりません。たとえば、[A-Z] と指定することはできますが、[Z-A] と指定すると文字の範囲は正しく解釈されません。

角かっこの中に何も指定しないと ([])、長さ 0 の文字列 (") とみなされます。

一部の言語には、離れている 2 つの文字を意味する特殊文字がアルファベットに含まれています。たとえば、いくつかの言語では、文字 "a" と "e" が共に表示されるときに、文字 "a" を使って表します。Like 演算子は、単一の特殊文字と、異なる 2 つの文字が同等であると認識します。

このような特殊文字を使う言語をオペレーティングシステムの国別情報で設定すると、文字列式 pattern または文字列式 string 内の一方の特殊文字は、他方の文字列内の同等な連続する 2 文字と一致します。同様に角かっこで囲まれた (角かっこ自体はリスト内または範囲内にある) 文字列式 pattern 内の単一の特殊文字は、文字列式 string 内の同等の連続する 2 文字と一致します。

Like 演算子の使用例

次の例は、Like 演算子を使って、文字列とパターンを比較します。

Option Explicit

Dim MyCheck
MyCheck = "aBBBa" Like "a*a"            ' True を返します。
MyCheck = "F" Like "[A-Z]"              ' True を返します。
MyCheck = "F" Like "[!A-Z]"             ' False を返します。
MyCheck = "a2a" Like "a#a"              ' True を返します。
MyCheck = "aM5b" Like "a[L-P]#[!c-e]"   ' True を返します。
MyCheck = "BAT123khg" Like "B?T*"       ' True を返します。
MyCheck = "CAT123khg" Like "B?T*"       ' False を返します。

文字操作 HTML文法では使えない文字を変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Function TAGletterConversion(strLetter As String) As String
'***********************************
'HTML文法では使えない文字を変換
'***********************************
'strLetter 通常のテキストデータ

Dim cntWord As Long
Dim strWord As String
Dim strNewWord As String
Dim i As Long

Dim strNewLetter As String

cntWord = Len(strLetter) '文字数

For i = 1 To cntWord
    strWord = Mid(strLetter, i, 1)
        Select Case Asc(strWord)  '文字コード判別
            Case 13: strNewWord = "<br>"
            Case 32: strNewWord = " "
            Case 34: strNewWord = """
            Case 38: strNewWord = "&"
            Case 60: strNewWord = "<"
            Case 62: strNewWord = ">"
            Case Else: strNewWord = strWord
        End Select
    strNewLetter = strNewLetter & strNewWord
Next i
    TAGletterConversion = strNewLetter
'-------------------------------------------------------------------
'Asc 関数
'指定した文字列内にある先頭の文字の文字コードを返す変換関数です。
Debug.Print Asc(vbCr)
Debug.Print Asc(" ")
Debug.Print Asc("""")
Debug.Print Asc("&")
Debug.Print Asc("<")
Debug.Print Asc(">")
'13
'32
'34
'38
'60
'62

'Chr 関数
'指定した文字コードに対応する文字を示す文字列型 (String) の値を返します。
Debug.Print Chr(13)
Debug.Print Chr(32)
Debug.Print Chr(34)
Debug.Print Chr(38)
Debug.Print Chr(60)
Debug.Print Chr(62)
'キャリッジリターン
'空白(半角スペース)
'"
'&
'<
'>

End Function

連携別ブックのマクロを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Application.Run "odo.xls Macro2"

連携他のブックのSub・Functionステートメントを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub OthersBookSub(strPath As String, FileName As String, ModuleName As String _
, StatementName As String)
'****************************************
'他のブックのSubステートメントを実行する
'****************************************
'※使用するブックは開かれているものとする
'strPath:       呼び出すブックのパス(C:\など)
'FileName:      呼び出すブック名（パスは不要・.xlsは必要）
'ModuleName:    呼び出すモジュール名(Module1など)
'StatementName: 呼び出すSubステートメント名(Testなど)

Dim bk As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set bk = Workbooks.Open(strPath & FileName)

Application.Run FileName & "!" & ModuleName & "." & StatementName

bk.Close SaveChanges:=False

Set bk = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True

'使用例
'(各項目を変数で記述する場合)
'Application.Run NewBok.Name & "!" & "Module5" & "." & "ExcelSheetAllProtect"
'(直接記述)
'Application.Run "NewBok.xls!Module5.ExcelSheetAllProtect"

'※実際はこのような２重な使い方はしません。
End Sub

Function OthersBookFun(strPath As String, FileName As String, ModuleName As String _
, StatementName As String, vrn As Variant) As Variant
'**********************************************
'他のブックのFunctionステートメントを実行する
'**********************************************
'※使用するブックは開かれているものとする
'strPath:       呼び出すブックのパス(C:\など)
'FileName:      呼び出すブック名（パスは不要）
'ModuleName:    呼び出すモジュール名
'StatementName: 呼び出すFunctionステートメント名
'vrn:           呼び出すFunctionステートメントの引数
Dim bk As Workbook, vr As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set bk = Workbooks.Open(strPath & FileName)

vr = _
Application.Run(FileName & "!" & ModuleName & "." & StatementName, vrn)

bk.Close SaveChanges:=False
Set bk = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
OthersBookFun = vr

'使用例は上記参照

'※実際はこのような２重な使い方はしません。
End Function

Private Sub test()
Dim sht As Worksheet, strad As String, Lad As String
Dim XlsName As String
XlsName = "test.xls"
Set sht = ThisWorkbook.Worksheets("test")

With sht
strad = .Cells(.Cells(65536, 4).End(xlUp).Row, 2).Value
End With

Lad = ServerAddressLocal(strad) & "\"
OthersBookSub Lad, XlsName, "testModule", "testsub"
End Sub

連携指定シートをPDFファイルにして保存

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub MakingPDF()
'*****************************************
'実行コード
'*****************************************
'PDFCreator.exeの参照設定が不可の場合は終了
If PDFCreatorFromFile = False Then Exit Sub
'作成実行
PrintToPDF_Early
End Sub

Function PDFCreatorFromFile() As Boolean
'*****************************************
'PDFCreator.exe参照設定
'*****************************************

    Dim objName As String

    'PDFCreator.exeの場所
    objName = "C:\Program Files\PDFCreator\PDFCreator.exe"

    If Dir(objName) = "" Then
        MsgBox "「PDFCreator.exe」が見つかりません！", vbCritical, "参照設定Error!"
        PDFCreatorFromFile = False
    Else
        ThisWorkbook.VBProject.References.AddFromFile (objName)
        PDFCreatorFromFile = True
    End If

End Function

Sub PrintToPDF_Early()
'*****************************************
'選択中のシートをPDFファイルに変換する
'*****************************************
'無料オープンソース[PDFCreator]
'http://sourceforge.net/projects/pdfcreator/
'参考ソース
'http://www.excelguru.ca/node/21
'PDFCreator参照設定必要
'試した動作環境：XP HE SP3,EXCEL2000(VB6.0)

    Dim PDFオブジェクト As PDFCreator.clsPDFCreator
    Dim PDFファイル名 As String
    Dim PDF作成パス As String

    '作成するPDFファイル名指定
    PDFファイル名 = "テスト.pdf" '日本語ＯＫ
    'そのPDFファイルの保存場所
    PDF作成パス = ActiveWorkbook.Path & Application.PathSeparator
    'PathSeparator：(\) を返す
    '※パスを個別に指定する場合、日本語に対応するか不明

    '空の値の場合は終了（シート空白）
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
    'IsEmpty：Empty 値の場合に、真 (True) を返す
    'UsedRange：指定されたワークシートで使われたセル範囲 (Range オブジェクト) を返す

    Set PDFオブジェクト = New PDFCreator.clsPDFCreator

    'PDFCreatorへの命令
    With PDFオブジェクト
        If .cStart("/NoProcessingAtStartup") = False Then '（※注意）
            MsgBox "PDFCreatorが初期化されていません！", vbCritical + _
                    vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = PDF作成パス
        .cOption("AutosaveFilename") = PDFファイル名
        .cOption("AutosaveFormat") = 0    ' 0 = PDF
        .cClearCache
    End With
    '（※注意）PDFCreatorが挙動がおかしく動作しない場合は
    'タスクマネージャープロセスからPDFCreatorを強制終了させる。
    'タスクマネージャー[alt]+[ctrl]+[del]

    '印刷実行プリンターは「PDFCreator」を選択
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

    'オペレーティングシステムに制御
    Do Until PDFオブジェクト.cCountOfPrintjobs = 1
        DoEvents
    Loop
    PDFオブジェクト.cPrinterStop = False

    'オペレーティングシステムに制御
    Do Until PDFオブジェクト.cCountOfPrintjobs = 0
        DoEvents
    Loop

    'PDFCreator閉じる
    PDFオブジェクト.cClose

    'PDFCreator開放
    Set PDFオブジェクト = Nothing
End Sub

連携他のブックのAuto_Openプロシージャを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub AppRun()
'*******************************************************************************
'他のブックのAuto_Openプロシージャを実行する
'*******************************************************************************
Application.Run "見積書作成.xls Auto_Open"

End Sub

連携 Excelの起動・アクティブ・終了時にマクロを実行-イベント内に記述する方法

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

WorkbookEvent

自動実行には2通りの方法がある。エクセル起動後全てに発生させるAuto_Openと各ブック単位で発生させるワークブックイベントここではワークブックイベントの記述方法を紹介します

Visual Basic Editor起動
ThisWorkbook オブジェクト
ダブルクリック
※Sheetに対しても設置可能です。

右上の
Object
Workbookにする
Workbookしかない

いきなり
Workbook_Openが記述されます。
不要な場合は後で消せます。

他のイベントを選択するには
図のように選択します。
イベント名とその働きは下図を参考にして下さい。

Option Explicit

Private Sub Workbook_Open()
MsgBox "Workbook_Open"
End Sub

Private Sub Workbook_Activate()
MsgBox "Workbook_Activate"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
MsgBox "Workbook_BeforeClose"
End Sub

Workbookイベント一覧<2000>
イベント		対象	働き（タイミング）
Workbook	Activate	ブック	アクティブになったら発生
	AddinInstall		アドインとして組み込まれたら発生
	AddinnUninstall		アドインから解除されたら発生
	BeforeClose		閉じられる前
	BeforePrint		印刷される前
	BeforeSave		保存される前
	Deactive		アクティブでなくなったら発生
	NewSheet		新規シートを追加されたら発生
	Open		開かれたら発生
	SheetActive	シート	アクティブになったら発生
	SheetBeforeDoubleClick		ダブルクリックされたら発生
	SheetBeforeRightClick		右クリックされたら発生
	SheetCalculate		再計算されたら発生
	SheetChange		セルの値が変更されたら発生
	SheetDeactive		アクティブでなくなったら発生
	SheetFollowHyperlink		ハイパーリンクをクリックしたら発生
	SheetSelectionChange		セルの選択範囲が変更されたら発生
	WindowActivate	ウインドウ	アクティブになったら発生
	WindowDeactivate		アクティブでなくなったら発生
	WindowResize		大きさが変更されたら発生

Worksheetkイベント一覧

Option Explicit

Private Sub Worksheet_Activate()
'アクティブになったら発生
End Sub

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean) '引数が必要
'ダブルクリックされたら発生
End Sub

Private Sub Worksheet_BeforeRightClick _
(ByVal Target As Range, Cancel As Boolean) '引数が必要
'右クリックされたら発生
End Sub

Private Sub Worksheet_Calculate()
'再計算されたら発生
End Sub

Private Sub Worksheet_Change _
(ByVal Target As Range) '引数が必要
'セルの値が変更されたら発生
End Sub

Private Sub Worksheet_Deactivate()
'アクティブでなくなったら発生
End Sub

Private Sub Worksheet_FollowHyperlink _
(ByVal Target As Hyperlink) '引数が必要
'ハイパーリンクをクリックしたら発生
End Sub

Private Sub Worksheet_SelectionChange _
(ByVal Target As Range) '引数が必要
'セルの選択範囲が変更されたら発生
End Sub

連携 WindowsScriptHostを使いVBやVBA制御

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

WindowsScriptHost

WSH(Windows Script Host)-VBS-スクリプト言語
WSHはスクリプト言語VBScriptやJScriptを利用可能
COMオブジェクト(Windows機能)を制御可能
VBScriptの拡張子[.vbs]
JScriptの拡張子[.js]
[.wsf]利用可能
記述編集にはテキスト・エディタを使用する又は
Office付属するMicrosoft Script Editorを使用する
実行はダブルクリックで実行可能
スクリプト・ホストは以下の２種類
wscript.exe（WScript）入力-ダイアログ・ボックス、出力-メッセージ・ボックスつまり「GUIベース」
script.exe（CScript）入力-コマンド・プロンプト、出力-コマンド・プロンプトつまり「コンソール・ベース」

上がVBScript[.vbs] 下がJScript[.js]

test.vbs内容記述
'// 全ドライブのごみ箱を空にする。

Set shell = WScript.CreateObject( "Shell.Application" )
For Each DesktopFolder In shell.NameSpace( 0 ).Items
If DesktopFolder.Name = "ごみ箱" Then
DesktopFolder.InvokeVerb "ごみ箱を空にする(&B)"
WScript.Quit 0
End If
Next

上のtest.vbsを実行すると

test.js内容記述
// メモ帳を起動する

// 変数定義
exec = "notepad.exe";
// 検索
var shell = WScript.CreateObject( "WScript.Shell" );
shell.Run( exec );

下のtest.jsを実行すると

編集記述は通常はメモ帳で十分（右クリック-編集）
Microsoft Script Editorでも編集可能

実際のMicrosoft Script Editor画面

TestVBS.vbsを実行する

TestVBS.vbs内容記述
'// エクセルVBAマクロを実行する

set obj = CreateObject("Excel.Application")
obj.Workbooks.Open("C:\Temp\test.xls")
obj.Visible = true
obj.run "TestSub"
test.xlsのTestSub内容記述

Option Explicit

Sub TestSub()
MsgBox "成功！"
End Sub

通常の起動だとセキュリティ設定にもよるが図のようなメッセージが表示される .vbsからの起動だと表示されない

連携 CSVファイルをmdbファイルに取り込むMicrosoftAccess

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Microsoft Excelでは65536の壁があるため巨大なデータは取り込めない

Microsoft Accessのファイル-開く

テキストリンクウィザードが自動で現れる

格納されている事を確認

文字操作ドライブを表す文字を返します｡

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Function GetDriveObjectStr(str As String) As String
'*******************************************************************************
'ドライブを表す文字を返します｡
'*******************************************************************************
    Dim Fso
    Set Fso = CreateObject("Scripting.FileSystemObject")
    ''C:を返します
    GetDriveObjectStr = Fso.GetDriveName(str)
End Function

文字操作スペースを使用したファイル名などのパラメータの記述

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

strFileName = ""C:\Test No1\Test.txt"" ""C:\Test No2\Test.txt""

文字操作テキストファイル読込レコード数５

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub TxtOpen()
'Tool_Name
'テキストファイル読込(y=レコード数５)
Dim strTarget As String
Dim x As Integer
'y=Dim y As Integer
Dim sht As Worksheet
Dim txtTar As String
Dim MyPath As String

Set sht = Workbooks("Test.xls").Worksheets("Sheet1") '**SET**
txtTar = "tst.txt" '**SET**
MyPath = "C:\WINDOWS\ﾃﾞｽｸﾄｯﾌﾟ" '**SET**

Application.ScreenUpdating = False

sht.Columns("a:a").Clear 'y=sht.Columns("a:a").Clear

sht.Activate

Open MyPath & "\" & txtTar For Input As #1 'ターゲットテキストオープン
Do Until EOF(1)
Input #1, strTarget
'y=Input #1, strTarget(1),strTarget(2),strTarget(3),strTarget(4),strTarget(5)
'y=For y = 1 to 5
x = x + 1
Cells(x, 1) = strTarget 'y=(y)
'y=Next y
Loop

Close #1

Set sht = Nothing
End Sub

文字操作 Split関数で文字列を分割

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub LetterSplit()
'****************************
'Split関数で文字列を分割
'****************************
'引数が空白でもエラーは起りません
'引数内に区切り文字(検索文字)がない場合でもエラー無し

Dim moji As String
Dim FoundMoji As String
Dim Msg As String
Dim j As Variant
Dim i As Long

moji = "あ a v  GG"
FoundMoji = " "

'区切り文字(検索文字)がスペースの場合は引数不要
j = Split(moji)
'j = Split(moji, FoundMoji)
    For i = LBound(j) To UBound(j)
    Msg = Msg & i + 1 & vbTab & j(i) & vbCr
    Next i
MsgBox Msg

End Sub

文字操作 OptionCompareステートメント文字列データの既定の比較方法を設定する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Compare ステートメント

文字列データの既定の比較方法を設定します。モジュールレベルで使います。

構文

Option Compare {Binary | Text | Database}

解説

Option Compare ステートメントを使う場合は、モジュール内のどのプロシージャよりも前に記述する必要があります。

Option Compare ステートメントは、モジュール内での文字列の比較方法 (Binary モード、Text モード、または Database モード) を指定するものです。Option Compare ステートメントが記述されていないモジュールでは、既定の文字列比較方法である Binary モードが使われます。

Binary モード

では、文字列比較の並べ替え順序は、バイナリ文字コードのコード順によって行われます。Microsoft WIndows 版 Visual Basicでは、文字コードは Unicode で表現されるので、結果は Unicode のコード順によって決まります。Binary モードでの並べ替えの例を次に示します。(ただし、バージョン4.0 以前の Windows 16bit 版 Visual Basic、または Macintosh 版 Visual Basic では、文字コードはシフト JISで表現されていたため、結果が異なる場合があります。)

* < "a" < "z" < "あ" < "ん" < "ア" < "ン" < "亜" < "＊" < "Ａ" < "ｱ" < "ﾝ"

Text モード

では、文字列比較は、オペレーティングシステムの国別情報の設定で決まります。日本語/日本の場合は、50 音順で、大文字と小文字、文字幅、カタカナとひらがなを区別しない並べ替え順になります。Text モードでの並べ替えの例を次に示します。

(*=＊) < (0=０) < (9=９) < (A=a=Ａ=ａ) < (B=b=Ｂ=ｂ) < (ｱ=ア=あ) < (ﾝ=ン=ん) < 亜

Database モードは、Microsoft Access でのみ使用できます。このモードの文字列比較の並べ替え順序は、データベースの文字列比較に適用される国別の ID によって決まります。

Option Compare ステートメントの使用例

次の例では、Option Compare ステートメントを使って、既定の文字列比較方法を変更します。Option Compare ステートメントは、モジュールレベルでのみ使用します。

' 文字列比較方法を Binary モードに設定します。
Option Compare Binary ' "AAA" は、"aaa" よりも小さくなります。
' 文字列比較方法を Text モードに設定します。
Option Compare Text ' "AAA" と "aaa" は、等価です。

その他のOption キーワード

Option Base ステートメント

配列の添字の最小値の既定値を設定します。モジュールレベルで使用します。

'Option Base ステートメントの使用例
'次の例では、Option Base ステートメントを使って、
'配列の添字の既定の最小値 0 を変更します。LBound
'関数は、配列内の指定された次元の添字の最小値を返します。
'Option Base ステートメントは、モジュールレベルでのみ使います。

Option Base 1            ' 配列の添字の既定値を 1 に設定します。

Dim Lower
Dim MyArray(20), TwoDArray(3, 4)        ' 配列変数を宣言します。
Dim ZeroArray(0 To 5)    ' 添字の既定の最小値を変更します。
' 配列の添字の最小値を求めるには、LBound 関数を使います。
Lower = LBound(MyArray)             ' 1 が返ります。
Lower = LBound(TwoDArray, 2)        ' 1 が返ります。
Lower = LBound(ZeroArray)           ' 0 が返ります。

Option Explicit ステートメント

モジュール内のすべての変数に対して、明示的な宣言を強制します。モジュールレベルで使用します。

'Option Explicit ステートメントの使用例
'次の例では、Option Explicit ステートメントを使って、
'すべての変数を明示的に宣言するように設定します。宣言
'されていない変数を使うとコンパイル時にエラーが発生します。
'Option Explicit ステートメントは、モジュールレベルでのみ使用します。

Option Explicit    ' すべての変数を明示的に宣言するようにします。
Dim MyVar            ' 変数を宣言します。
MyInt = 10        ' 宣言されていない変数を使うとエラーが発生します。
MyVar = 10        ' 宣言済みの変数であれば、エラーは発生しません。

Option Private ステートメント

複数のプロジェクト間で参照可能なホストアプリケーションにおいて Option Private Module ステートメントを使うと、プロジェクトの外部からモジュールの内容が参照できなくなります。単独で Visual Basic を使用している場合など、外部からの参照を許可しないホストアプリケーションでは、Option Private ステートメントは無効です。

'Option Private ステートメントの使用例
'次の例では、Option Private ステートメントをモジュールレベルで使って、
'モジュール全体をプライベートとして設定します。Option Private Module
'では、Private 宣言を行っていないモジュールレベルの要素は、そのモジュール
'が含まれるプロジェクト内からは参照できますが、ほかのアプリケーションやほか
'のプロジェクトからは参照できません。

Option Private Module
' モジュールがプライベートであることを示します。

文字操作キャリッジリターンラインフィード等

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

その他の定数

次の定数は Visual Basic for Applications のタイプライブラリで定義されており、実際の値の代わりにコード内のどの部分でも使うことができます。

定数	値	内容
vbCrLf	Chr(13) + Chr(10)	キャリッジリターンとラインフィードの組み合わせ
vbCr	Chr(13)	キャリッジリターン文字
vbLf	Chr(10)	ラインフィード文字
vbNullChar	Chr(0)	値 0 を持つ文字
vbNewLine	Chr(13) + Chr(10) または Chr(13) (Macintosh では Chr(13))	プラットフォームで指定した改行文字。現在のプラットフォームで適切ないずれかを使用します。
vbNullString	値 0 を持つ文字列	長さ 0 の文字列 (") とは異なります。外部プロシージャを呼び出す場合に使用します。
vbTab	Chr(9)	タブ文字
vbBack	Chr(8)	バックスペース文字
vbFormFeed	Chr(12)	Microsoft Windows または Macintosh では使用できません。
vbVerticalTab	Chr(11)	Microsoft Windows または Macintosh では使用できません。

文字操作シート上のテキストから特定文字群を抽出

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub TxtSarch()
'
Dim strTarget As String
Dim x As Long
Dim y As Long
Dim z As Integer
Dim i As Integer
Dim j As Long
Dim k As Byte
Dim sht As Worksheet
Dim shtOut As Worksheet
Dim strFind As String
Dim strFind2 As String
Dim strOutTXT As String

Set sht = Workbooks("Test.xls").Worksheets("Sheet1") '**SET**
Set shtOut = Workbooks("Test.xls").Worksheets("Sheet2") '**SET**

strFind = "zip" '**SET**
strFind2 = "http:" '**SET**

k = Len(strFind)
x = sht.Range("a65536").End(xlUp).Row

For y = 1 To x
    strTarget = sht.Range("a" & y).Value
    i = InStr(strTarget, strFind)
        If i <> 0 Then
            z = InStr(strTarget, strFind2)
                If z <> 0 Then
                    strOutTXT = Mid(strTarget, z, i - z + k)
                    j = shtOut.Range("a1").CurrentRegion.Rows.Count + 1
                    shtOut.Range("a" & j).Value = strOutTXT
                End If
        End If
Next y

Set sht = Nothing
Set shtOut = Nothing

End Sub

文字操作ひらがな・カタカナをローマ字(英字)変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Dim strTwo(64, 2) As String, strOne(85, 2) As String

Public Function RomajiConversion(ByVal HiraKata As String) As String
'****************************************************
'ひらがな・カタカナをローマ字(英字)変換
'****************************************************
'引数[HiraKata]を全てローマ字小文字(英字)変換
'引数[HiraKata]はひらがな・カタカナ何れも変換可能(※1)
'注意サブプロシージャー[ReadTable]が同じモジュール内に必要
'「なっとう」等の[っ]の場合、ローマ字特有の「na[tt]ou」[tt]を処理(※2)

Dim CnvOne As String, CnvTwo As String
Dim strTemporary As String
Dim str As String
Dim blnFlg As Boolean
Dim cnt As Long
Dim intMach As Integer

ReadTable 'テーブル読込

'(※1)---------------------------------------------------------------------
'vbHiragana : 文字列内のカタカナをひらがなに変換します。
'vbWide : 文字列内の半角文字 (1 バイト) を全角文字 (2 バイト) に変換します。
'既にひらがなの場合はそのまま変換しません。
HiraKata = StrConv(HiraKata, vbHiragana Or vbWide)
'--------------------------------------------------------------------------

'初期設定
strTemporary = ""
cnt = 1
blnFlg = False

Do While cnt <= Len(HiraKata) '文字列全てを処理

  CnvTwo = "" '初期設定
  CnvOne = "" '初期設定

  '注意 Do...Loop ステートメントは永久ループの危険ありの為、使用不可

  '２文字の該当値検索
  str = Mid(HiraKata, cnt, 2) '該当文字格納
  For intMach = 1 To 64
    If str = strTwo(intMach, 1) Then
        CnvTwo = strTwo(intMach, 2)
    Exit For '合致なら抜ける
    End If
  Next intMach

  '１文字の該当値検索
  str = Mid(HiraKata, cnt, 1) '該当文字格納
  For intMach = 1 To 85
    If str = strOne(intMach, 1) Then
        CnvOne = strOne(intMach, 2)
    Exit For '合致なら抜ける
    End If
  Next intMach

  If CnvTwo <> "" Then '２文字変換完了の場合

    If blnFlg Then 'フラグが該当する場合
      strTemporary = strTemporary & Left(CnvTwo, 1)
      '２文字変換中１文字だけ余分に追加
    End If
    strTemporary = strTemporary & CnvTwo '２文字追加
    cnt = cnt + 2 '処理を２つ進める
    blnFlg = False '該当フラグを降ろす

  ElseIf CnvOne <> "" Then '１文字変換完了の場合

    If blnFlg Then 'フラグが該当する場合
      strTemporary = strTemporary & Left(CnvOne, 1)
      '１文字余分に追加
    End If
    strTemporary = strTemporary & CnvOne '１文字追加
    cnt = cnt + 1 '処理を１つ進める
    blnFlg = False '該当フラグを降ろす

  ElseIf Mid(HiraKata, cnt, 1) = "っ" Then
  '(※2)両方無変換の場合で該当文字が「っ」の場合

    blnFlg = True '該当フラグを立てる
    cnt = cnt + 1 '処理を１つ進める

  Else

    strTemporary = strTemporary & Mid(HiraKata, cnt, 1)
    '全てに該当しない場合
    cnt = cnt + 1 '処理を１つ進める

  End If

Loop

RomajiConversion = strTemporary

End Function

Private Sub ReadTable()
'***********************************
'RomajiConversion用テーブル
'***********************************
'*ひらがな・カタカナをローマ字変換テーブル
'「っ」はありません
'「ん」は「n」にて変換、用途により「nn」変更してください。
'長音「ろーま」は「ro-ma」[-]で処理

    strTwo(1, 1) = "きぃ": strTwo(1, 2) = "kyi"
    strTwo(2, 1) = "きぇ": strTwo(2, 2) = "kye"
    strTwo(3, 1) = "きゃ": strTwo(3, 2) = "kya"
    strTwo(4, 1) = "きゅ": strTwo(4, 2) = "kyu"
    strTwo(5, 1) = "きょ": strTwo(5, 2) = "kyo"
    strTwo(6, 1) = "ぎぃ": strTwo(6, 2) = "gyi"
    strTwo(7, 1) = "ぎぇ": strTwo(7, 2) = "gye"
    strTwo(8, 1) = "ぎゃ": strTwo(8, 2) = "gya"
    strTwo(9, 1) = "ぎゅ": strTwo(9, 2) = "gyu"
    strTwo(10, 1) = "ぎょ": strTwo(10, 2) = "gyo"
    strTwo(11, 1) = "しぃ": strTwo(11, 2) = "syi"
    strTwo(12, 1) = "しぇ": strTwo(12, 2) = "she"
    strTwo(13, 1) = "しゃ": strTwo(13, 2) = "sha"
    strTwo(14, 1) = "しゅ": strTwo(14, 2) = "shu"
    strTwo(15, 1) = "しょ": strTwo(15, 2) = "sho"
    strTwo(16, 1) = "じぃ": strTwo(16, 2) = "zyi"
    strTwo(17, 1) = "じぇ": strTwo(17, 2) = "je"
    strTwo(18, 1) = "じゃ": strTwo(18, 2) = "ja"
    strTwo(19, 1) = "じゅ": strTwo(19, 2) = "ju"
    strTwo(20, 1) = "じょ": strTwo(20, 2) = "jo"
    strTwo(21, 1) = "ちぃ": strTwo(21, 2) = "tyi"
    strTwo(22, 1) = "ちぇ": strTwo(22, 2) = "che"
    strTwo(23, 1) = "ちゃ": strTwo(23, 2) = "cha"
    strTwo(24, 1) = "ちゅ": strTwo(24, 2) = "chu"
    strTwo(25, 1) = "ちょ": strTwo(25, 2) = "cho"
    strTwo(26, 1) = "ぢぃ": strTwo(26, 2) = "dyi"
    strTwo(27, 1) = "ぢぇ": strTwo(27, 2) = "dye"
    strTwo(28, 1) = "ぢゃ": strTwo(28, 2) = "dya"
    strTwo(29, 1) = "ぢゅ": strTwo(29, 2) = "dyu"
    strTwo(30, 1) = "ぢょ": strTwo(30, 2) = "dyo"
    strTwo(31, 1) = "にぃ": strTwo(31, 2) = "nyi"
    strTwo(32, 1) = "にぇ": strTwo(32, 2) = "nye"
    strTwo(33, 1) = "にゃ": strTwo(33, 2) = "nya"
    strTwo(34, 1) = "にゅ": strTwo(34, 2) = "nyu"
    strTwo(35, 1) = "にょ": strTwo(35, 2) = "nyo"
    strTwo(36, 1) = "ひぃ": strTwo(36, 2) = "hyi"
    strTwo(37, 1) = "ひぇ": strTwo(37, 2) = "hye"
    strTwo(38, 1) = "ひゃ": strTwo(38, 2) = "hya"
    strTwo(39, 1) = "ひゅ": strTwo(39, 2) = "hyu"
    strTwo(40, 1) = "ひょ": strTwo(40, 2) = "hyo"
    strTwo(41, 1) = "びぃ": strTwo(41, 2) = "byi"
    strTwo(42, 1) = "びぇ": strTwo(42, 2) = "bye"
    strTwo(43, 1) = "びゃ": strTwo(43, 2) = "bya"
    strTwo(44, 1) = "びゅ": strTwo(44, 2) = "byu"
    strTwo(45, 1) = "びょ": strTwo(45, 2) = "byo"
    strTwo(46, 1) = "ぴぃ": strTwo(46, 2) = "pyi"
    strTwo(47, 1) = "ぴぇ": strTwo(47, 2) = "pye"
    strTwo(48, 1) = "ぴゃ": strTwo(48, 2) = "pya"
    strTwo(49, 1) = "ぴゅ": strTwo(49, 2) = "pyu"
    strTwo(50, 1) = "ぴょ": strTwo(50, 2) = "pyo"
    strTwo(51, 1) = "ふぁ": strTwo(51, 2) = "fa"
    strTwo(52, 1) = "ふぃ": strTwo(52, 2) = "fi"
    strTwo(53, 1) = "ふぇ": strTwo(53, 2) = "fe"
    strTwo(54, 1) = "ふぉ": strTwo(54, 2) = "fo"
    strTwo(55, 1) = "みぃ": strTwo(55, 2) = "myi"
    strTwo(56, 1) = "みぇ": strTwo(56, 2) = "mye"
    strTwo(57, 1) = "みゃ": strTwo(57, 2) = "mya"
    strTwo(58, 1) = "みゅ": strTwo(58, 2) = "myu"
    strTwo(59, 1) = "みょ": strTwo(59, 2) = "myo"
    strTwo(60, 1) = "りぃ": strTwo(60, 2) = "ryi"
    strTwo(61, 1) = "りぇ": strTwo(61, 2) = "rye"
    strTwo(62, 1) = "りゃ": strTwo(62, 2) = "rya"
    strTwo(63, 1) = "りゅ": strTwo(63, 2) = "ryu"
    strTwo(64, 1) = "りょ": strTwo(64, 2) = "ryo"

    strOne(1, 1) = "ー": strOne(1, 2) = "-"
    strOne(2, 1) = "ぁ": strOne(2, 2) = "xa"
    strOne(3, 1) = "あ": strOne(3, 2) = "a"
    strOne(4, 1) = "ぃ": strOne(4, 2) = "xi"
    strOne(5, 1) = "い": strOne(5, 2) = "i"
    strOne(6, 1) = "ぅ": strOne(6, 2) = "xu"
    strOne(7, 1) = "う": strOne(7, 2) = "u"
    strOne(8, 1) = "ぇ": strOne(8, 2) = "xe"
    strOne(9, 1) = "え": strOne(9, 2) = "e"
    strOne(10, 1) = "ぉ": strOne(10, 2) = "xo"
    strOne(11, 1) = "お": strOne(11, 2) = "o"
    strOne(12, 1) = "か": strOne(12, 2) = "ka"
    strOne(13, 1) = "が": strOne(13, 2) = "ga"
    strOne(14, 1) = "き": strOne(14, 2) = "ki"
    strOne(15, 1) = "ぎ": strOne(15, 2) = "gi"
    strOne(16, 1) = "く": strOne(16, 2) = "ku"
    strOne(17, 1) = "ぐ": strOne(17, 2) = "gu"
    strOne(18, 1) = "け": strOne(18, 2) = "ke"
    strOne(19, 1) = "げ": strOne(19, 2) = "ge"
    strOne(20, 1) = "こ": strOne(20, 2) = "ko"
    strOne(21, 1) = "ご": strOne(21, 2) = "go"
    strOne(22, 1) = "さ": strOne(22, 2) = "sa"
    strOne(23, 1) = "ざ": strOne(23, 2) = "za"
    strOne(24, 1) = "し": strOne(24, 2) = "shi"
    strOne(25, 1) = "じ": strOne(25, 2) = "ji"
    strOne(26, 1) = "す": strOne(26, 2) = "su"
    strOne(27, 1) = "ず": strOne(27, 2) = "zu"
    strOne(28, 1) = "せ": strOne(28, 2) = "se"
    strOne(29, 1) = "ぜ": strOne(29, 2) = "ze"
    strOne(30, 1) = "そ": strOne(30, 2) = "so"
    strOne(31, 1) = "ぞ": strOne(31, 2) = "zo"
    strOne(32, 1) = "た": strOne(32, 2) = "ta"
    strOne(33, 1) = "だ": strOne(33, 2) = "da"
    strOne(34, 1) = "ち": strOne(34, 2) = "chi"
    strOne(35, 1) = "ぢ": strOne(35, 2) = "di"
    strOne(36, 1) = "つ": strOne(36, 2) = "tsu"
    strOne(37, 1) = "づ": strOne(37, 2) = "du"
    strOne(38, 1) = "て": strOne(38, 2) = "te"
    strOne(39, 1) = "で": strOne(39, 2) = "de"
    strOne(40, 1) = "と": strOne(40, 2) = "to"
    strOne(41, 1) = "ど": strOne(41, 2) = "do"
    strOne(42, 1) = "な": strOne(42, 2) = "na"
    strOne(43, 1) = "に": strOne(43, 2) = "ni"
    strOne(44, 1) = "ぬ": strOne(44, 2) = "nu"
    strOne(45, 1) = "ね": strOne(45, 2) = "ne"
    strOne(46, 1) = "の": strOne(46, 2) = "no"
    strOne(47, 1) = "は": strOne(47, 2) = "ha"
    strOne(48, 1) = "ば": strOne(48, 2) = "ba"
    strOne(49, 1) = "ぱ": strOne(49, 2) = "pa"
    strOne(50, 1) = "ひ": strOne(50, 2) = "hi"
    strOne(51, 1) = "び": strOne(51, 2) = "bi"
    strOne(52, 1) = "ぴ": strOne(52, 2) = "pi"
    strOne(53, 1) = "ふ": strOne(53, 2) = "fu"
    strOne(54, 1) = "ぶ": strOne(54, 2) = "bu"
    strOne(55, 1) = "ぷ": strOne(55, 2) = "pu"
    strOne(56, 1) = "へ": strOne(56, 2) = "he"
    strOne(57, 1) = "べ": strOne(57, 2) = "be"
    strOne(58, 1) = "ぺ": strOne(58, 2) = "pe"
    strOne(59, 1) = "ほ": strOne(59, 2) = "ho"
    strOne(60, 1) = "ぼ": strOne(60, 2) = "bo"
    strOne(61, 1) = "ぽ": strOne(61, 2) = "po"
    strOne(62, 1) = "ま": strOne(62, 2) = "ma"
    strOne(63, 1) = "み": strOne(63, 2) = "mi"
    strOne(64, 1) = "む": strOne(64, 2) = "mu"
    strOne(65, 1) = "め": strOne(65, 2) = "me"
    strOne(66, 1) = "も": strOne(66, 2) = "mo"
    strOne(67, 1) = "ゃ": strOne(67, 2) = "xya"
    strOne(68, 1) = "や": strOne(68, 2) = "ya"
    strOne(69, 1) = "ゅ": strOne(69, 2) = "xyu"
    strOne(70, 1) = "ゆ": strOne(70, 2) = "yu"
    strOne(71, 1) = "ょ": strOne(71, 2) = "xyo"
    strOne(72, 1) = "よ": strOne(72, 2) = "yo"
    strOne(73, 1) = "ら": strOne(73, 2) = "ra"
    strOne(74, 1) = "り": strOne(74, 2) = "ri"
    strOne(75, 1) = "る": strOne(75, 2) = "ru"
    strOne(76, 1) = "れ": strOne(76, 2) = "re"
    strOne(77, 1) = "ろ": strOne(77, 2) = "ro"
    strOne(78, 1) = "わ": strOne(78, 2) = "wa"
    strOne(79, 1) = "ゐ": strOne(79, 2) = "wi"
    strOne(80, 1) = "ゑ": strOne(80, 2) = "we"
    strOne(81, 1) = "を": strOne(81, 2) = "wo"
    strOne(82, 1) = "ん": strOne(82, 2) = "n"
    strOne(83, 1) = "ゑ": strOne(83, 2) = "we"
    strOne(84, 1) = "を": strOne(84, 2) = "wo"
    strOne(85, 1) = "ん": strOne(85, 2) = "n"

End Sub

Private Sub test()
MsgBox RomajiConversion("ろーま")
MsgBox RomajiConversion("ハムレット")
End Sub

文字操作バイナリモードで指定文字列から指定文字を抜き出す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function CharacterFind(ByVal Character As String, _
ByVal FirstStr As String, ByVal LastStr As String) As String
'****************************************************
'バイナリモードで指定文字列から指定文字を抜き出す
'****************************************************
'どちらか一方でも見つからない場合は=""を返します。
'引数LastStrの文字は、引数FirstStrの文字の後から探します。
'引数LastStrは引数FirstStrの文字の次の文字からの検索になります。
Dim i As Long, n As Long
i = InStr(1, Character, FirstStr, vbBinaryCompare)
If i = 0 Then CharacterFind = "": Exit Function
n = InStr(i, Character, LastStr, vbBinaryCompare)
If n = 0 Then CharacterFind = "": Exit Function
CharacterFind = Mid(Character, i, n + Len(LastStr) - i)
'<モードの違い>
'┌─────────┬───┬────┬────┐
'│内容              │例    │バイナリ│テキスト│
'├─────────┼───┼────┼────┤
'│大文字/小文字     │A/a   │異      │同      │
'│全角/半角         │Ａ/A  │異      │同      │
'│ひらがな/カタカナ │あ/ア │異      │同      │
'└─────────┴───┴────┴────┘
End Function

Private Sub test()
Dim a As String
a = "ちワあ　　dいうえおちワkoんにちワお元気zですか"
'「ちワ」は３つ目をヒットさせます。
Debug.Print CharacterFind(a, "ko", "ちワ")
'koんにちワ
End Sub

文字操作バイナリモードで指定文字列から指定文字を抜き出す(指定文字を除去)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function CharacterFindNext(ByVal Character As String, _
ByVal FirstStr As String, ByVal LastStr As String) As String
'*****************************************************************
'バイナリモードで指定文字列から指定文字を抜き出す(指定文字を除去)
'*****************************************************************
'どちらか一方でも見つからない場合は=""を返します。
'引数LastStrの文字は、引数FirstStrの文字の後から探します。
'引数LastStrは引数FirstStrの文字の次の文字からの検索になります。
'引数LastStrと引数FirstStrの文字は除きます。
Dim i As Long, n As Long
i = InStr(1, Character, FirstStr, vbBinaryCompare)
If i = 0 Then CharacterFindNext = "": Exit Function
n = InStr(i, Character, LastStr, vbBinaryCompare)
If n = 0 Then CharacterFindNext = "": Exit Function
CharacterFindNext = Mid(Character, i + Len(FirstStr), _
n + Len(LastStr) - (i + Len(FirstStr)) - Len(LastStr))
'<モードの違い>
'┌─────────┬───┬────┬────┐
'│内容              │例    │バイナリ│テキスト│
'├─────────┼───┼────┼────┤
'│大文字/小文字     │A/a   │異      │同      │
'│全角/半角         │Ａ/A  │異      │同      │
'│ひらがな/カタカナ │あ/ア │異      │同      │
'└─────────┴───┴────┴────┘
End Function

Private Sub test()
Dim a As String
a = "ちワYyあ　　dいうえおちワXxzkoんにちワYyお元気zですか"
'「ちワ」は３つ目をヒットさせます。
Debug.Print CharacterFindNext(a, "Xxz", "Yy")
'koんにちワ
End Sub

文字操作フリガナ変換・付ける・返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'*******************************************************************************
'フリガナ変換
'*******************************************************************************
Me.TextBox7.Value = _
StrConv(Application.GetPhonetic(Me.TextBox5.Value), vbHiragana)
End Sub

Private Sub フリガナを付ける()
'*******************************************************************************
'フリガナを付ける
'*******************************************************************************
Dim sht As Worksheet, a As Long, b As Long, c As Long, d As String, e As String

'Set sht = ThisWorkbook.Worksheets("Sheet2")
Dim Xname As String
'***********************************
Xname = "給料_外注先.xls"
'***********************************
Set sht = Workbooks(Xname).Worksheets("Sheet1")

With sht
    b = Fnc最終行(sht)
    For a = 1 To b
        If a <> 1 Then
            For c = 2 To 2
                .Cells(a, c + 1).Value = Application.GetPhonetic(.Cells(a, c))
            Next c
        Else
            .Cells(a, 3).Value = "フリガナ"
        End If
    Next a
End With
End Sub

Public Function fncフリガナ(str As String) As String
'*******************************************************************************
'フリガナを返す
'*******************************************************************************
fncフリガナ = Application.GetPhonetic(str)
End Function

文字操作ファイル内文字付番置換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Dim lngNo&

Sub ファイル内文字付番置換()
'***************************************************
'大量の同じ文字が記述されているファイルのその各同じ文字
'に番号を付ける
'***************************************************
FileReadingAndWriting ThisWorkbook.Path & "\参照雛形\index.txt", "vbサムネイル", "vbサムネイル"
End Sub

Private Sub FileReadingAndWriting(対象ファイル$, 検索字$, 置換字$)
'***************************************************
'大量の同じ文字が記述されているファイルのその各同じ文字
'に番号を付ける
'***************************************************
Dim RetrievalCharacter$, ConversionCharacter$
Dim OriginalFile$, ReproductionFile$
Dim WritingFile As Integer, ReadingFile As Integer
Dim strDAT$, lngCnt&

'パラメータ設定部----------------------------------------------------
'元のファイルフルパスとファイル名
OriginalFile = 対象ファイル
'コピーするファイルとファイル名
ReproductionFile = ThisWorkbook.Path & "\Copy" & Format(Date, "yymmdd") & Format(Time, "hhmmss") & ".txt"
'検索文字
RetrievalCharacter = 検索字
'置換文字
ConversionCharacter = 置換字
'--------------------------------------------------------------------

'エラーが発生した場合次のステートメントから実行継続
On Error Resume Next

'ファイルコピーの実行
FileCopy OriginalFile, ReproductionFile

'エラーが発生した場合
If Err <> 0 Then
    MsgBox "Error" & Err, vbCritical, "Error"
    Exit Sub
End If

'元のファイル削除
Kill OriginalFile

'使用可能なファイル番号取得
WritingFile = FreeFile()
Open ReproductionFile For Input As #WritingFile

'使用可能なファイル番号取得
ReadingFile = FreeFile()
Open OriginalFile For Output As #ReadingFile

'変数初期化
lngCnt = 0
'グローバル変数の初期化
lngNo = 0

Do Until EOF(WritingFile) '最後(全て)
    'ファイル読込
    Line Input #WritingFile, strDAT
    '置換実行(Function)---------------↓対象文字列------↓検索文字------↓置換文字
    lngCnt = lngCnt + FncstrReplace(strDAT, RetrievalCharacter, ConversionCharacter)
    'ファイルに挿入
    Print #ReadingFile, strDAT
Loop

'それぞれのファイルを閉じる
Close #WritingFile
Close #ReadingFile

'最初にコピーしたファイルを削除
Kill ReproductionFile

End Sub

Private Function FncstrReplace&(ByRef 対象文字列$, 検索文字$, 置換文字$)
'***********************************************************************
'大量の指定文字を検索し順番に番号を付ける
'***********************************************************************

Dim RetrievalResultPosition&, RetrievalBeginningNumber&
Dim ReplacementCharacterNumber&, ConversionCharacterNumber&
Dim strNO$

    '重複防止検索開始番号初期化
    RetrievalBeginningNumber = 1

    'パラメータ設定
        '置換え側[+ 3]は付ける番号の文字数又は桁数)
        ReplacementCharacterNumber = Len(置換文字) + 3
        '検索側
        ConversionCharacterNumber = Len(検索文字)

    Do
        '対象文字列の検索文字位置取得
        RetrievalResultPosition = InStr(RetrievalBeginningNumber, 対象文字列, 検索文字, vbBinaryCompare)
        '検索文字が[0]の場合
        If RetrievalResultPosition = 0 Then Exit Do

        FncstrReplace = FncstrReplace + 1

        'グローバル変数の値を増加
        lngNo = lngNo + 1

        '付加する番号を３桁にする
        strNO = Format(lngNo, "00#")

        '置換
        対象文字列 = Left$(対象文字列, RetrievalResultPosition - 1) & 置換文字 & strNO _
          & Right$(対象文字列, Len(対象文字列) - RetrievalResultPosition - ConversionCharacterNumber + 1)

        '重複検索を防止
        RetrievalBeginningNumber = RetrievalResultPosition + ReplacementCharacterNumber
    Loop

End Function

文字操作ローカルパス[¥]をサーバ用パス[/]へ変更

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function PathSignChangeS(strPath As String) As String
'*****************************************
'ローカルパス[\]をサーバ用パス[/]へ変更
'*****************************************

Dim cntLen As Long
Dim cntByt As Long

'文字列中に2byte文字が含まれているか判定
cntLen = Len(strPath)
cntByt = LenB(StrConv(strPath, vbFromUnicode))

If (cntLen <> cntByt) Then
    MsgBox "2byte文字が含まれています！", vbCritical, "PathSignChange"
    PathSignChangeS = ""
Else
    PathSignChangeS = Replace(strPath, "\", "/")
End If

End Function

Function PathSignChangeE(strPath As String) As String
'*****************************************
'サーバ用パス[/]をローカルパス[\]へ変更
'*****************************************

Dim cntLen As Long
Dim cntByt As Long

'文字列中に2byte文字が含まれているか判定
cntLen = Len(strPath)
cntByt = LenB(StrConv(strPath, vbFromUnicode))

If (cntLen <> cntByt) Then
    MsgBox "2byte文字が含まれています！", vbCritical, "PathSignChange"
    PathSignChangeE = ""
Else
    PathSignChangeE = Replace(strPath, "/", "\")
End If

End Function

Private Sub testS()
MsgBox PathSignChangeS("K\06\PR\exe\www\XXX")
End Sub

Private Sub testE()
MsgBox PathSignChangeE("K/06\PR/exe/www/XXX")
End Sub

変数 Enumステートメント列挙変数「列挙型」

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'列挙型 (Enum) を宣言します。
'
'構文
'
'[Public | Private] Enum name
'
'membername [= constantexpression]
'
'membername [= constantexpression]

'. . .

'End Enum

'Enum ステートメントの構文は､次の指定項目から構成されます｡
'
'指定項目
'Public
'Private
'name
'membername
'constantexpression
'
'解説
'
'列挙変数は、列挙型 (Enum) を用いて宣言する変数です。変数とパラメータのどちらも、列挙型で宣言できます。列挙型の要素は、Enum ステートメントにおいて指定された定数値に初期化されます。割り当てられた値は、実行時には変更できません。正の値でも、負の値でも設定できます。次は、列挙型の使用例です。

Enum SecurityLevel
    IllegalEntry = -1
    SecurityLevel1 = 0
    SecurityLevel2 = 1
End Enum

'Enum ステートメントは、モジュールレベルでのみ記述できます。列挙型 (Enum) が宣言されると、その列挙型を使って、変数、パラメータ、または列挙型を返すプロシージャを宣言できます。列挙型の名前は、モジュール名では修飾できません。クラスモジュール内のパブリックな列挙型 (Public Enum) は、クラスのメンバではありません。ただし、それらはタイプライブラリに書き込まれます。標準モジュールにおいて定義された列挙型 (Enum) は、タイプライブラリには書き込まれません。同じ名前のパブリックな列挙型 (Public Enum) は同じ名前空間を共有するので、このような列挙型は標準モジュールとクラスモジュールでは定義できません。異なる種類のライブラリの中の 2 つの列挙型 (Enum) に同じ名前が付けられていて、その要素が異なる場合、その型の変数への参照においてどちらの列挙型が使われるかは、その参照においてどちらの種類のライブラリが高い優先順位を持つかで決まります。
'
'列挙型 (Enum) は、With ブロックの対象としては使えません。

'Enum ステートメントの使用例

'次の例では､Enum ステートメントを使って､名前付き定数の集合を定義しています｡ここで定義している定数は､データベースに対するデータ入力フォームをデザインする際に選択できる色です｡

Public Enum InterfaceColors
    icMistyRose = &HE1E4FF
    icSlateGray = &H908070
    icDodgerBlue = &HFF901E
    icDeepSkyBlue = &HFFBF00
    icSpringGreen = &H7FFF00
    icForestGreen = &H228B22
    icGoldenrod = &H20A5DA
    icFirebrick = &H2222B2
End Enum

配列変数が配列変数かどうかを調べます

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ExamineArrayVariable()
'***********************************
'変数が配列変数かどうかを調べます｡
'***********************************

Dim Array1(1 To 5) As Integer, Array2, Array3
Array2 = Array(1, 2, 3)
Array3 = "4"
'IsArray 関数
MsgBox IsArray(Array1)
MsgBox IsArray(Array2)
MsgBox IsArray(Array3)

End Sub

変数 Constステートメント型と値を一度で宣言

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Const ステートメント

Const ステートメント

リテラル値の代わりに使う定数を宣言します。

構文
[Public | Private] Const constname [As type] = expression
Const ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
Public
省略可能です。すべてのモジュール内のすべてのプロシージャから参照可能な定数を宣言するために、モジュールレベルで使用するキーワードです。プロシージャ内では、指定できません。
Private
省略可能です。宣言が行われたモジュール内のプロシージャからのみ参照できる定数を宣言するときに指定するキーワードです。モジュールレベルで使用します。プロシージャ内では指定できません。
constname
必ず指定します。定義する定数の名前を指定します。変数の標準的な名前付け規則に従って指定します。
type
省略可能です。定数のデータ型を指定します。バイト型 (Byte)、ブール型 (Boolean)、整数型 (Integer)、長整数型 (Long)、通貨型 (Currency)、単精度浮動小数点型 (Single)、倍精度浮動小数点数型 (Double)、10 進数型 (Decimal) (現在はサポートされていません)、日付型 (Date)、文字列型 (String)、またはバリアント型 (Variant) のいずれかを指定できます。宣言する各変数に対して、As type 節を個別に指定します。
expression
必ず指定します。リテラル値、その他の定数、Is を除く算術演算子や論理演算子を組み合わせた式を指定します。
解説
既定では、定数はプライベート
になります。プロシージャ内では、定数は常にプライベート定数として扱われて、適用範囲 (スコープ) は変更できません。標準モジュールでは、モジュールレベル定数の既定の適用範囲をキーワード Public で変更できます。一方、クラスモジュールでは、定数はプライベート定数としてのみ使用でき、キーワード Public では適用範囲を変更できません。
複数の定数宣言を 1 行にまとめるには
、定数定義をカンマ (,) で区切ります。このようにして複数の定数を 1 行で宣言した場合、キーワード Public やキーワード Private を指定すると、すべての定数定義に対してキーワードが適用されます。
定数に代入する式の中では、変数、ユーザー定義関数、Chr などの Visual Basic の組込み関数は、使えません。
メモ
定数を使うと、プログラムがわかりやすく、修正も容易になります。変数とは異なり、定数はプログラムの実行中に値を変更できません。
As type で定数のデータ型を明示的に宣言しない場合、代入する式の評価結果に最適なデータ型が割り当てられます。
Sub プロシージャ、Function プロシージャ、または Property プロシージャ内で宣言した定数は、そのプロシージャ内でのみ参照できます。プロシージャの外で宣言された定数は、宣言されたモジュール内であれば、どこからでも参照できます。定数は、式が記述できる位置であれば、どこでも使えます。

Const ステートメントの使用例

次の例では、Const ステートメントを使って、リテラル値の代わりに使われる定数を宣言しています。パブリック (Public) 定数は、クラスモジュールではなく、標準モジュールの宣言セクションに記述します。プライベート (Private) 定数は、どの種類のモジュールの宣言セクションにも記述できます。

Option Explicit

'既定の設定では、定数はプライベート (Private) です。
    Const MyVar = 459

'パブリック (Public) 定数を宣言します。
    Public Const MyString = "HELP"

'プライベートの整数型 (Integer) 定数を宣言します。
    Private Const MyInt As Integer = 5

'1行で複数の定数を宣言します。
    Const MyStr = "Hello", MyDouble As Double = 3.4567

配列配列を使った変数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'◆通常の変数 Dim strTest As String
'
'◆配列変数 Dim strTest(5) As string
'strTest (0)
'strTest (1)
'strTest (2)
'strTest (3)
'strTest (4)
'strTest (5)
'デフォルトでは添字は０（ゼロ）から始まる。
'
'◆モジュールの頭に、Option Base 1 宣言
'strTest (1)
'strTest (2)
'strTest (3)
'strTest (4)
'strTest (5)
'
'◆部分的
'Dim strName(1 To 5) As String
'strTest (1)
'strTest (2)
'strTest (3)
'strTest (4)
'strTest (5)
'
'※エクセルの場合、多くは１から始まるため、Option Base 1 を宣言した方が無難。
'
'◆2次元の場合
'※多次元の場合は､60次元までの配列を宣言可能することができます｡
'Dim strTest(4, 4) As String
'strTest(0,0) から strTest(0,4) 小計５個
'strTest(1,0) から strTest(1,4) 小計５個
'strTest(2,0) から strTest(2,4) 小計５個
'strTest(3,0) から strTest(3,4) 小計５個
'strTest(4,0) から strTest(4,4) 小計５個
'合計25個

配列配列の同じ要素を削除するCollection

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ArraySameElementDelCollection(ByVal DB As Variant, ByRef DB2() As String)
'*****************************************************
'配列配列の同じ要素を削除するCollection
'*****************************************************

Dim cllArray As Collection, vrn As Variant, i As Long

Set cllArray = New Collection

On Error Resume Next
    For Each vrn In DB
        cllArray.Add vrn, vrn
    Next
On Error GoTo 0

ReDim DB2(cllArray.Count - 1)
    For i = 1 To cllArray.Count
        DB2(i - 1) = cllArray(i)
    Next

End Sub

Private Sub test()
Dim i As Long, x(5) As String, DB2() As String
'テストデータ
x(0) = "1"
x(1) = "A"
x(2) = "1"
x(3) = "B"
x(4) = ""
x(5) = "1"

Call ArraySameElementDelCollection(x, DB2())

'値を表示
    For i = LBound(DB2) To UBound(DB2)
        Debug.Print i & vbTab & DB2(i)
    Next i

'0   1
'1   A
'2   B
'3
End Sub

配列配列作成

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

dim c
'合計４１個の配列の場合（０から始まることに注意）
c = Array(76, 77, 78, 79, 80, 81, 83, 84, 86, 88, 90, 92, 94, 95, 96, 99, 100, 101, 104, 105, 106, 107, 108, 109, 111, 113, 115, 117, 129, 131, 132, 134, 136, 137, 139, 140, 142, 144, 145, 147, 744)
For b = 0 To 40
Me("TextBox" & c(b)).Value = ""
Next b

配列配列に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'配列かどうかの検査 IsArray
'配列を作成 Array
'既定最少値の変更 Option Base
'配列の宣言および初期化 Dim, Private, Public, ReDim, Static
'配列サイズの限度の検査 LBound, UBound
'配列を再初期化 Erase, ReDim
'

配列 Sortメソッド配列変数並替(文字列可・高速・2次元編)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub SortMethodArrayVariable2(ByRef strDataNew() As String, ByVal strDataOld As Variant)
'****************************************************
'Sortメソッド配列変数並替(文字列可・高速・2次元編)
'****************************************************
'エクセルのRangeオブジェクト使用の為65536個を超えると不可。
'ここでは[Callステートメント]による呼び出しで関数化してます。
'既存シートデータに影響が無い様、新シートを使用してます。
'新シートは使用後削除されます。
'より高速にするにはシートを予め用意しておく事です。
'ByVal strDataOld　で受け取った配列を
'ByRef strDataNew()　で返してます。

Dim NewSheet As Worksheet
Dim ArrayMin(1) As Long
Dim ArrayMax(1) As Long

Dim i As Long, j As Long
Dim strDataOldDummy() As String 'Rangeオブジェクト用配列変数
Dim rngDummy As Range
'画面更新しない
Application.ScreenUpdating = False
'新シート追加及びセット
Set NewSheet = ThisWorkbook.Worksheets.Add

ArrayMin(0) = LBound(strDataOld, 1) '受け取った配列変数最小値
ArrayMax(0) = UBound(strDataOld, 1) '受け取った配列変数最大値
ArrayMin(1) = LBound(strDataOld, 2) '受け取った配列変数最小値
ArrayMax(1) = UBound(strDataOld, 2) '受け取った配列変数最大値

'①受け取った配列変数をRangeオブジェクト用に配列変数を定義
ReDim strDataOldDummy((ArrayMin(0) + 1) To (ArrayMax(0) + 1), _
(ArrayMin(1) + 1) To (ArrayMax(1) + 1))
'②返す配列変数の格納数を定義
ReDim strDataNew(ArrayMin(0) To ArrayMax(0), ArrayMin(1) To ArrayMax(1))

    '受け取った配列変数①をRangeオブジェクト用配列変数にコピー
    For i = ArrayMin(0) To ArrayMax(0)
        For j = ArrayMin(1) To ArrayMax(1)
            strDataOldDummy(i + 1, j + 1) = strDataOld(i, j)
        Next j
    Next i

    With NewSheet

        '③Rangeオブジェクトをセット
        Set rngDummy = .Range(.Cells(ArrayMin(0) + 1, 1), .Cells(ArrayMax(0) + 1, 2))
        'セットしたRangeオブジェクト③にRangeオブジェクト用配列変数①をコピー
        rngDummy = strDataOldDummy
        '③RangeオブジェクトSortメソッド(降順)
        rngDummy.Sort Key1:=.Cells(1, 2), Order1:=xlDescending, Key2:=.Cells(1, 1), Order2:=xlDescending
        '返す配列変数②に格納
        For i = ArrayMin(0) + 1 To ArrayMax(0) + 1
        For j = ArrayMin(1) + 1 To ArrayMax(1) + 1
            strDataNew(i - 1, j - 1) = rngDummy(i, j)
        Next j
        Next i
        '③セット解除
        Set rngDummy = Nothing

    End With
    'マクロの実行中に特定の警告やメッセージを表示しない
    Application.DisplayAlerts = False
    NewSheet.Delete '追加した新シート削除
    'マクロの実行中に特定の警告やメッセージを表示する
    Application.DisplayAlerts = True
    Set NewSheet = Nothing 'セット解除

Application.ScreenUpdating = True '画面更新する

'**************************
'重要引数群
'**************************

'Key1   並べ替えの最初に優先されるキーとなるフィールド｡
'Order1 下記-Order-参照｡
'Key2   並べ替えの 2 番目に優先されるキーとなるフィールド。
'Order2 下記-Order-参照｡
'Key3   並べ替えの 3 番目に優先されるキーとなるフィールド。
'Order3 下記-Order-参照｡
'1以外は多次元時(3次元まで)に使用。

'-Order-
'昇順に並べ替えるには、xlAscending を指定します(既定)
'降順に並べ替えるには、xlDescending を指定します｡

'Header
'最初の行がタイトル行であるかどうかを指定。
'xlGuess-(自動判別)、xlNo-(タイトルなし(既定))、xlYes-(最初の行がタイトル行)

'MatchCase
'大文字と小文字を区別して並べ替えるには、True を指定。
'大文字と小文字を区別しないで並べ替えるには、False を指定。

End Sub

Private Sub test()
Dim strFile(5, 1) As String, str As String

strFile(0, 0) = "apple"
strFile(1, 0) = "apple"
strFile(2, 0) = "apple"
strFile(3, 0) = "windows"
strFile(4, 0) = "windows"
strFile(5, 0) = "windows"

strFile(0, 1) = "HD-x"
strFile(1, 1) = "HD-Y"
strFile(2, 1) = "HD-z"
strFile(3, 1) = "HD-A"
strFile(4, 1) = "HD-b"
strFile(5, 1) = "HD-c"

Dim strDataNew() As String

Call SortMethodArrayVariable2(strDataNew, strFile)

str = "(0, 0)：(0, 1)" & vbTab & strDataNew(0, 0) & " | " _
& strDataNew(0, 1) & vbCr
str = str & "(1, 0)：(1, 1)" & vbTab & strDataNew(1, 0) & " | " _
& strDataNew(1, 1) & vbCr
str = str & "(2, 0)：(2, 1)" & vbTab & strDataNew(2, 0) & " | " _
& strDataNew(2, 1) & vbCr
str = str & "(3, 0)：(3, 1)" & vbTab & strDataNew(3, 0) & " | " _
& strDataNew(3, 1) & vbCr
str = str & "(4, 0)：(4, 1)" & vbTab & strDataNew(4, 0) & " | " _
& strDataNew(4, 1) & vbCr
str = str & "(5, 0)：(5, 1)" & vbTab & strDataNew(5, 0) & " | " _
& strDataNew(5, 1) & vbCr

str = str & "合計数：" & vbTab & UBound(strDataNew, 1) + 1 & vbCr

MsgBox str
End Sub

日付時刻来月の第１日

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fnc来月の第1日(HIDUKE As Date) As String
'*******************************************************************************
'来月の第１日
'*******************************************************************************
fnc来月の第1日 = DateAdd("m", 1, DateSerial(Year(HIDUKE), Month(HIDUKE), 1))
End Function

配列 Sortメソッド配列変数並替(文字列可・高速・1次元編)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub SortMethodArrayVariable(ByRef strDataNew() As String, ByVal strDataOld As Variant)
'****************************************************
'Sortメソッド配列変数並替(文字列可・高速・1次元編)
'****************************************************
'エクセルのRangeオブジェクト使用の為65536個を超えると不可。
'ここでは[Callステートメント]による呼び出しで関数化してます。
'既存シートデータに影響が無い様、新シートを使用してます。
'新シートは使用後削除されます。
'より高速にするにはシートを予め用意しておく事です。
'ByVal strDataOld　で受け取った配列を
'ByRef strDataNew()　で返してます。

Dim NewSheet As Worksheet
Dim ArrayMin As Long
Dim ArrayMax As Long

Dim i As Long
Dim strDataOldDummy() As String 'Rangeオブジェクト用配列変数
Dim rngDummy As Range
'画面更新しない
Application.ScreenUpdating = False
'新シート追加及びセット
Set NewSheet = ThisWorkbook.Worksheets.Add

ArrayMin = LBound(strDataOld) '受け取った配列変数最小値
ArrayMax = UBound(strDataOld) '受け取った配列変数最大値

'①受け取った配列変数をRangeオブジェクト用に配列変数を定義
ReDim strDataOldDummy((ArrayMin + 1) To (ArrayMax + 1), 0)
'②返す配列変数の格納数を定義
ReDim strDataNew(ArrayMin To ArrayMax)

    '受け取った配列変数①をRangeオブジェクト用配列変数にコピー
    For i = ArrayMin To ArrayMax
        strDataOldDummy(i + 1, 0) = strDataOld(i)
    Next i

    With NewSheet

        '③Rangeオブジェクトをセット
        Set rngDummy = .Range(.Cells(ArrayMin + 1, 1), .Cells(ArrayMax + 1, 1))
        'セットしたRangeオブジェクト③にRangeオブジェクト用配列変数①をコピー
        rngDummy = strDataOldDummy
        '③RangeオブジェクトSortメソッド(降順)
        rngDummy.Sort Key1:=.Cells(1, 1), Order1:=xlDescending
        '返す配列変数②に格納
        For i = ArrayMin + 1 To ArrayMax + 1
            strDataNew(i - 1) = rngDummy(i, 1)
        Next i
        '③セット解除
        Set rngDummy = Nothing

    End With
    'マクロの実行中に特定の警告やメッセージを表示しない
    Application.DisplayAlerts = False
    NewSheet.Delete '追加した新シート削除
    'マクロの実行中に特定の警告やメッセージを表示する
    Application.DisplayAlerts = True
    Set NewSheet = Nothing 'セット解除

Application.ScreenUpdating = True '画面更新する

'**************************
'重要引数群
'**************************

'Key1   並べ替えの最初に優先されるキーとなるフィールド｡
'Order1 下記-Order-参照｡
'Key2   並べ替えの 2 番目に優先されるキーとなるフィールド。
'Order2 下記-Order-参照｡
'Key3   並べ替えの 3 番目に優先されるキーとなるフィールド。
'Order3 下記-Order-参照｡
'1以外は多次元時(3次元まで)に使用。

'-Order-
'昇順に並べ替えるには、xlAscending を指定します(既定)
'降順に並べ替えるには、xlDescending を指定します｡

'Header
'最初の行がタイトル行であるかどうかを指定。
'xlGuess-(自動判別)、xlNo-(タイトルなし(既定))、xlYes-(最初の行がタイトル行)

'MatchCase
'大文字と小文字を区別して並べ替えるには、True を指定。
'大文字と小文字を区別しないで並べ替えるには、False を指定。

End Sub

Private Sub test()
Dim strFile(5) As String

strFile(0) = "a"
strFile(1) = "b"
strFile(2) = "c"
strFile(3) = "d"
strFile(4) = "e"
strFile(5) = "f"

Dim strDataNew() As String

Call SortMethodArrayVariable(strDataNew, strFile)

MsgBox "最初は：" & strDataNew(LBound(strDataNew))
MsgBox "最後は：" & strDataNew(UBound(strDataNew))
MsgBox "合計数：" & UBound(strDataNew) + 1

End Sub

配列配列の使い方

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'配列を宣言すると、同じデータ型の 1 組の値を処理できます。通常の変数は、1 つの値を 1 つの区画に格納していますが、配列は、値を格納するために多くの区画を持つ 1 つの変数です。配列が格納しているすべての値を参照する場合は、配列全体を参照できます。また、配列の個々の要素を参照することもできます。
'
'たとえば、一年間の毎日の支出を記録する場合、365 個の変数を宣言する代わりに、365 の要素を持つ 1 つの配列変数を宣言することができます。配列の各要素には、1 つの値を持ちます。次のステートメントは、365 個の要素を持つ配列変数 curExpense を宣言します。特に指定しない限り、配列には 0 から始まるインデックス番号が付けられます。したがって、配列に指定するインデックスの最大値は、365 ではなく 364 となります。

Dim curExpense(364) As Currency

'各要素の値を設定するには、要素のインデックス番号を指定します。次の例は、配列の各要素に初期値 20 を代入します。

Sub FillArray()
    Dim curExpense(364) As Currency
    Dim intI As Integer
    For intI = 0 To 364
        curExpense(intI) = 20
    Next
End Sub

'インデックス番号の最小値の変更
'
'モジュールの先頭で Option Base ステートメントを使用すると、最初の要素の既定値を 0 から 1 に変更することができます。次の例では、Option Base ステートメントを使って、配列のインデックス番号の最小値を変更します。この Dim ステートメントは、365 の要素を持つ配列変数 curExpense を宣言します。

Option Base 1
Dim curExpense(365) As Currency

'次の例のように To 節を使って配列のインデックス番号の最小値を明示的に設定することもできます。

Dim curExpense(1 To 365) As Currency
Dim strWeekday(7 To 13) As String

'バリアント型 (Variant) の値の配列への格納
'
'バリアント型 (Variant) の値の配列を作成するには、次に示す 2 つの方法があります。1 つ目の方法は、次の例のようにバリアント型 (Variant) の配列を宣言する方法です。

Dim varData(3) As Variant
varData(0) = "Claudia Bendel"
varData(1) = "4242 Maple Blvd"
varData(2) = 38
varData(3) = Format("06-09-1952", "General Date")

'もう 1 つの方法は、次の例のように Array 関数で返される配列をバリアント型 (Variant) 変数に代入する方法です。

Dim varData As Variant
varData = Array("Ron Bendel", "4242 Maple Blvd", 38, _
Format("06-09-1952", "General Date"))

'どちらの方法で配列を作成しても、バリアント型 (Variant) の値の配列の要素を識別します。たとえば、次のステートメントは、前の 2 つの例のどちらにも追加できます。

MsgBox varData(0) & " に関するデータを記録しました。"

'多次元配列の使い方
'
'Visual Basic では、最大 60 次元までの配列を宣言することができます。たとえば次のステートメントは、2 次元の 5 ｘ 10 の配列を宣言します。

Dim sngMulti(1 To 5, 1 To 10) As Single

'配列を行列とすると､最初の引数は行､2 番目の引数は列を表します｡
'
'多次元の配列を処理するには、ネストさせた For...Next ステートメントを使います。次のプロシージャでは、単精度浮動小数点数型 (Single) の値を持つ 2 次元の配列を指定します。

Sub FillArrayMulti()
    Dim intI As Integer, intJ As Integer
    Dim sngMulti(1 To 5, 1 To 10) As Single

    ' 配列に値を格納します。
    For intI = 1 To 5
        For intJ = 1 To 10
            sngMulti(intI, intJ) = intI * intJ
            Debug.Print sngMulti(intI, intJ)
        Next intJ
    Next intI
End Sub

配列配列のコピー

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub Test()

Dim i As Long
Dim 動的配列A()
Dim 動的配列B()
Dim 静的配列C(5)
Dim 静的配列D(0 To 5)

Dim テスト動的配列A()
Dim テスト動的配列B()
Dim テスト動的配列C()
Dim テスト動的配列D()

For i = 0 To 5
    ReDim Preserve 動的配列A(i)
    ReDim Preserve 動的配列B(i)
    動的配列A(i) = "A" & i
    動的配列B(i) = "B" & i
    静的配列C(i) = "C" & i
    静的配列D(i) = "D" & i
Next i

テスト動的配列A = 動的配列A
テスト動的配列B = 動的配列B
テスト動的配列C = 静的配列C
テスト動的配列D = 静的配列D

For i = LBound(テスト動的配列A) To UBound(テスト動的配列A)
    Debug.Print テスト動的配列A(i)
Next i
'A0
'A1
'A2
'A3
'A4
'A5
For i = LBound(テスト動的配列B) To UBound(テスト動的配列B)
    Debug.Print テスト動的配列B(i)
Next i
'B0
'B1
'B2
'B3
'B4
'B5
For i = LBound(テスト動的配列C) To UBound(テスト動的配列C)
    Debug.Print テスト動的配列C(i)
Next i
'C0
'C1
'C2
'C3
'C4
'C5
For i = LBound(テスト動的配列D) To UBound(テスト動的配列D)
    Debug.Print テスト動的配列D(i)
Next i
'D0
'D1
'D2
'D3
'D4
'D5

'コピー元配列の値を変更します。
For i = 0 To 5
    動的配列A(i) = "w" & i
    動的配列B(i) = "x" & i
    静的配列C(i) = "y" & i
    静的配列D(i) = "z" & i
Next i

For i = LBound(テスト動的配列A) To UBound(テスト動的配列A)
    Debug.Print テスト動的配列A(i)
Next i
'A0
'A1
'A2
'A3
'A4
'A5
'値は変わりません
'参照渡しではなく値渡しだからです。
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub

配列配列の指定された次元で使用できる添字の最小値を返す。

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub 配列の最小値()
'******************************************************
'配列の指定された次元で使用できる添字の最小値を返す。
'******************************************************

Dim Upper(4) As Long
Dim MyArray(1 To 10, 5 To 15, 10 To 20) ' 配列変数を宣言します。
Dim AnyArray(10)

Upper(1) = LBound(MyArray, 1)    '  1 が返ります。
Upper(2) = LBound(MyArray, 2)    '  5 が返ります。
Upper(3) = LBound(MyArray, 3)    ' 10 が返ります。
Upper(4) = LBound(AnyArray)      '  0 が返ります。

MsgBox Upper(1) & vbCr & Upper(2) & vbCr & Upper(3) & vbCr & Upper(4)
End Sub

日付時刻年齢を算出する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function GetAge(Birthday As String, Sanshutubi As String) As Long
'引数[Birthday]:生年月日、String型でここにDate型に変換できないものが入ると「0」になる
'引数[Sanshutubi]:算出する該当日、String型でここにDate型に変換できないものが入ると「0」になる
'返値[GetAge]:Long型

Dim a As Date, b As Date, C As Date

If IsDate(Birthday) = False Or IsDate(Sanshutubi) = False Then
    GetAge = 0
Else
    a = CDate(Birthday): b = CDate(Sanshutubi)
    C = DateSerial(Year(b), Month(a), Day(a))

        If C <= Date Then
            GetAge = Year(b) - Year(a)
        Else
            GetAge = Year(b) - Year(a) - 1
        End If
End If
End Function

Private Sub Test()
Dim a As String, b As String
a = InputBox("生年月日", "", "")
b = InputBox("算出する該当日", "", Date)
MsgBox GetAge(a, b)
End Sub

日付時刻日付/時刻表示書式指定文字の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'(VB:Help)
'----------------------------------------------------
'yy/mm/dd               = 58/12/07
'mm -d                  = 12 - 7
'd -mmmm - yy           = 7 - December - 58
'd mmmm                 = 7 December
'mmmm yy                = December 58
'ddddd(aaa)             = 58/12/07(日)
'dddddd                 = 1958 年 12 月 7 日日曜日
'ggge年m月d日(aaaa)     = 昭和33年12月7日(日曜日)
'hh:mm AM/PM            = 08:50 PM
'h:mm:ss a/p            = 8:50:35 p
'h:mm                   = 20:50
'h:mm:ss                = 20:50:35
'm/d/yy h:mm            = 12/7/58 20:50
'----------------------------------------------------
'****************************************************
'日付/時刻表示書式指定文字 (Format 関数)
'****************************************************

'c
'ddddd および t t t t t の書式で表した日付と時刻を、日付、時刻の順序で返します。
'指定された値に小数部がない場合は日付のみ、整数部がない場合は時刻のみを表す文字列を返します。
Private Sub testc()
    MsgBox Format(Now, "c")
    Debug.Print Format(Now, "c") '出力例[2009/09/18 15:19:58]
End Sub

'ddd
'曜日を英語 (省略形) で返します (Sun ～ Sat)。
Private Sub testddd()
MsgBox Format(Now, "ddd")
Debug.Print Format(Now, "ddd") '出力例[Fri]
End Sub

'aaa
'曜日を日本語 (省略形) で返します (日～土)。
Private Sub testaaa()
MsgBox Format(Now, "aaa")
Debug.Print Format(Now, "aaa") '出力例[金]
End Sub

'dddd
'曜日を英語で返します (Sunday ～ Saturday)。
Private Sub testdddd()
MsgBox Format(Now, "dddd")
Debug.Print Format(Now, "dddd") '出力例[Friday]
End Sub

'aaaa
'曜日を日本語で返します (日曜日～土曜日)。
Private Sub testaaaa()
MsgBox Format(Now, "aaaa")
Debug.Print Format(Now, "aaaa") '出力例[金曜日]
End Sub

'ddddd
'年、月、日を含む短い形式 (コントロールパネルで設定) で表した日付を返します。
'既定の短い日付形式は、m/d/yy です。
Private Sub testddddd()
MsgBox Format(Now, "ddddd")
Debug.Print Format(Now, "ddddd") '出力例[2009/09/18]
End Sub

'dddddd
'年、月、日を含む長い形式 (コントロールパネルで設定) で表した日付を返します。
'既定の長い日付形式は mmmm dd, yyyy です。
Private Sub testdddddd()
MsgBox Format(Now, "dddddd")
Debug.Print Format(Now, "dddddd") '出力例[2009年9月18日]
End Sub

'w
'曜日を表す数値を返します (日曜日が 1、土曜日が 7 となります)。
Private Sub testw()
MsgBox Format(Now, "w")
Debug.Print Format(Now, "w") '出力例[6]
End Sub

'ww
'その日が一年のうちで何週目に当たるかを表す数値を返します (1 ～ 54)。
Private Sub testww()
MsgBox Format(Now, "ww")
Debug.Print Format(Now, "ww") '出力例[38]
End Sub

'mmm
'月の名前を英語 (省略形) の文字列に変換して返します (Jan ～ Dec)。
Private Sub testmmm()
MsgBox Format(Now, "mmm")
Debug.Print Format(Now, "mmm") '出力例[Sep]
End Sub

'mmmm
'月の名前を英語で返します (January ～ December)。
Private Sub testmmmm()
MsgBox Format(Now, "mmmm")
Debug.Print Format(Now, "mmmm") '出力例[September]
End Sub

'oooo
'月の名前を日本語で返します (1 月～ 12 月)。
Private Sub testoooo()
MsgBox Format(Now, "oooo")
Debug.Print Format(Now, "oooo") '出力例[9月]
End Sub

'q
'1 年のうちで何番目の四半期に当たるかを表す数値を返します (1 ～ 4)。
Private Sub testq()
MsgBox Format(Now, "q")
Debug.Print Format(Now, "q") '出力例[3]
End Sub

'g
'年号の頭文字を返します (M、T、S、H)。
Private Sub testg()
MsgBox Format(Now, "g")
Debug.Print Format(Now, "g") '出力例[H]
End Sub

'gg
'年号の先頭の 1 文字を漢字で返します (明、大、昭、平)。
Private Sub testgg()
MsgBox Format(Now, "gg")
Debug.Print Format(Now, "gg") '出力例[平]
End Sub

'ggg
'年号を返します (明治、大正、昭和、平成)。
Private Sub testggg()
MsgBox Format(Now, "ggg")
Debug.Print Format(Now, "ggg") '出力例[平成]
End Sub

'e
'年号に基づく和暦の年を返します。1 桁の場合、先頭に 0 が付きません。
Private Sub teste()
MsgBox Format(Now, "e")
Debug.Print Format(Now, "e") '出力例[21]
End Sub

'EE
'年号に基づく和暦の年を 2 桁の数値を使って返します。1 桁の場合、先頭に 0 が付きます。
Private Sub testee()
MsgBox Format("1991/09/18", "ee")
Debug.Print Format("1991/09/18", "ee") '出力例[03]
End Sub

'y
'1 年のうちで何日目に当たるかを数値で返します (1 ～ 366)。
Private Sub testy()
MsgBox Format("1991/09/18", "y")
Debug.Print Format("1991/09/18", "y") '出力例[261]
End Sub

'yy
'西暦の年を下 2 桁の数値で返します (00 ～ 99)。
Private Sub testyy()
MsgBox Format("1991/09/18", "yy")
Debug.Print Format("1991/09/18", "yy") '出力例[91]
End Sub

'yyyy
'西暦の年を 4 桁の数値で返します (100 ～ 9999)。
Private Sub testyyyy()
MsgBox Format("1991/09/18", "yyyy")
Debug.Print Format("1991/09/18", "yyyy") '出力例[1991]
End Sub

'h
'時間を返します。1 桁の場合、先頭に 0 が付きません (0 ～ 23)。
Private Sub testh()
MsgBox Format("2009/09/18 15:19:58", "h")
Debug.Print Format("2009/09/18 15:19:58", "h") '出力例[15]
End Sub

'hh
'時間を返します。1 桁の場合、先頭に 0 が付きます (00 ～ 23)。
Private Sub testhh()
MsgBox Format("2009/09/18 05:19:58", "hh")
Debug.Print Format("2009/09/18 05:19:58", "hh") '出力例[05]
End Sub

'N
'分を返します。1 桁の場合、先頭に 0 が付きません (0 ～ 59)。
Private Sub testn()
MsgBox Format("2009/09/18 05:19:58", "n")
Debug.Print Format("2009/09/18 05:19:58", "n") '出力例[19]
End Sub

'nn
'分を返します。1 桁の場合、先頭に 0 が付きます (00 ～ 59)。
Private Sub testnn()
MsgBox Format("2009/09/18 05:09:58", "nn")
Debug.Print Format("2009/09/18 05:09:58", "nn") '出力例[09]
End Sub

's
'秒を返します。1 桁の場合、先頭に 0 が付きません (0 ～ 59)。
Private Sub tests()
MsgBox Format("2009/09/18 05:09:58", "s")
Debug.Print Format("2009/09/18 05:09:58", "s") '出力例[58]
End Sub

'ss
'秒を返します。1 桁の場合、先頭に 0 が付きます (00 ～ 59)。
Private Sub testss()
MsgBox Format("2009/09/18 05:09:08", "ss")
Debug.Print Format("2009/09/18 05:09:08", "ss") '出力例[08]
End Sub

'tttttt
'コントロールパネルで設定されている形式で時刻を返します｡
'先頭に 0 を付けるオプションが選択されていて、時刻が午前または午後 10 時以前の場合、
'先頭に 0 が付きます。既定の形式は、h:mm:ss です。
Private Sub testtttt()
MsgBox Format("2009/09/18 05:09:08", "ttttt")
Debug.Print Format("2009/09/18 05:09:08", "ttttt") '出力例[5:09:08]
End Sub

'AM/PM
'時刻が正午以前の場合は大文字で AM を返し、正午～午後 11 時 59 分の間は大文字で PM を返します。
Private Sub testAMPM()
MsgBox Format("2009/09/18 05:09:08", "AM/PM")
Debug.Print Format("2009/09/18 05:09:08", "AM/PM") '出力例[AM]
End Sub

'am/pm
'時刻が正午以前の場合は小文字で am を返し、正午～午後 11 時 59 分の間は小文字で pm を返します。
Private Sub testAMPM2()
MsgBox Format("2009/09/18 05:09:08", "am/pm")
Debug.Print Format("2009/09/18 05:09:08", "am/pm") '出力例[am]
End Sub

'A/P
'時刻が正午以前の場合は大文字で A を返し、正午～午後 11 時 59 分の間は大文字で P を返します。
Private Sub testAP()
MsgBox Format("2009/09/18 05:09:08", "A/P")
Debug.Print Format("2009/09/18 05:09:08", "A/P") '出力例[A]
End Sub

'a/p
'時刻が正午以前の場合は小文字で a を返し、正午～午後 11 時 59 分の間は小文字で p を返します。
Private Sub testAP2()
MsgBox Format("2009/09/18 05:09:08", "a/p")
Debug.Print Format("2009/09/18 05:09:08", "a/p") '出力例[a]
End Sub

'AMPM
'"12 時間制" が選択されていて、時刻が正午以前の場合は午前を表すリテラル文字列を、
'正午～午後 11 時 59 分の間は午後を表すリテラル文字列を返します。
'これらの文字列の設定および "12 時間制" の選択は、コントロールパネルで行います。
'AMPM は大文字、小文字のどちらでも指定できます。既定の形式は、AM/PM です。
Private Sub testAMPM3()
MsgBox Format("2009/09/18 05:09:08", "AMPM")
Debug.Print Format("2009/09/18 05:09:08", "AMPM") '出力例[午前]
End Sub

'定義済み日付/時刻書式 (Format 関数)
'
'General Date
'日付または時刻､あるいはその両方を返します｡整数部と小数部の両方を含む数値を指定すると､
'日付と時刻の両方を表す文字列 (たとえば 96/4/3 5:34) に変換します。小数部がない場合には日付のみ
'(たとえば 96/4/3)、整数部がない場合には時刻のみ (たとえば 5:34) を表す文字列に変換します。
'日付と時刻の表示形式はコントロールパネルの設定により決まります｡
Private Sub testGeneralDate()
MsgBox Format("2009/09/18 05:09:08", "General Date")
Debug.Print Format("2009/09/18 05:09:08", "General Date") '出力例[2009/09/18 5:09:08]
End Sub

'Long Date
'日付の長い形式 (コントロールパネルの設定) で表した日付を返します。
Private Sub testLongDate()
MsgBox Format("2009/09/18 05:09:08", "Long Date")
Debug.Print Format("2009/09/18 05:09:08", "Long Date") '出力例[2009年9月18日]
End Sub

'Medium Date
'簡略形式で表した日付を返します｡ホストアプリケーションで使用されます｡
Private Sub testMediumDate()
MsgBox Format("2009/09/18 05:09:08", "Medium Date")
Debug.Print Format("2009/09/18 05:09:08", "Medium Date") '出力例[09-09-18]
End Sub

'Short Date
'日付の短い形式 (コントロールパネルの設定) で表した日付を返します。
Private Sub testShortDate()
MsgBox Format("2009/09/18 05:09:08", "Short Date")
Debug.Print Format("2009/09/18 05:09:08", "Short Date") '出力例[2009/09/18]
End Sub

'Long Time
'時刻､分､秒を含む形式で表した時刻を返します｡
Private Sub testLongTime()
MsgBox Format("2009/09/18 05:09:08", "Long Time")
Debug.Print Format("2009/09/18 05:09:08", "Long Time") '出力例[5:09:08]
End Sub

'Medium Time
'時間と分を 12 時間制で表した時刻を返します。同時に午前 (AM)、午後 (PM) も追加します。
Private Sub testMediumTime()
MsgBox Format("2009/09/18 05:09:08", "Medium Time")
Debug.Print Format("2009/09/18 05:09:08", "Medium Time") '出力例[05:09 午前]
End Sub

'Short Time
'時間と分を 24 時間制で表した時刻 (たとえば 17:45) を返します。
Private Sub testShortTime()
MsgBox Format("2009/09/18 05:09:08", "Short Time")
Debug.Print Format("2009/09/18 05:09:08", "Short Time") '出力例[05:09]
End Sub

日付時刻日付と時刻に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

┌─────────────┬─────┬─────┬─────┐
│種別                      │          │          │          │
├─────────────┼─────┼─────┼─────┤
│現在の日付または時間の取得│Date      │ Now      │ Time     │
│日付計算の実行            │DateAdd   │ DateDiff │ DatePart │
│日付の取得                │DateSerial│ DateValue│          │
│時間の取得                │TimeSerial│ TimeValue│          │
│現在の日付または時間の設定│Date      │ Time     │          │
│処理時間の計測            │Timer     │          │          │
└─────────────┴─────┴─────┴─────┘

日付時刻実行中のマクロを指定の秒数(1/1000)停止Timer関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Timer 関数

午前 0 時 (真夜中) から経過した秒数を表す単精度浮動小数点数型 (Single) の値を返します。

構文
Timer
解説
Microsoft Windows では、Timer 関数は小数点以下の値も返します。Macintosh では、小数点以下の値は返されません。

Timer 関数の使用例

次の例は、Timer 関数を使って、プログラムの実行を中断します。この例では、DoEvents ステートメントを使って、プログラムが中断している間も他のプロセスを割り込みで処理できます。

Option Explicit

Sub TimerWait(PauseTime As Double)
'************************************
'指定した秒数の間マクロを止める
'************************************

Dim Start As Double

Start = Timer
    Do While Timer < Start + PauseTime
        DoEvents
    Loop

End Sub

Private Sub test()

Dim PauseTime As Double
Dim Start As Double
Dim Finish As Double
Dim TotalTime As Double

PauseTime = 0.1

    Start = Timer
        TimerWait PauseTime
    Finish = Timer
    TotalTime = Finish - Start
Debug.Print TotalTime
' 0.109000000000378

End Sub

日付時刻実行中のマクロを指定の時刻まで停止WaitメソッドTimeValue関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub TimeWait(lngSecond As Long)
'************************************
'指定した秒数の間マクロを止める
'************************************

'引数 lngSecond には秒数を！
Dim newHour As String
Dim newMinute As String
Dim newSecond As String
Dim waitTime As Variant

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + lngSecond
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

End Sub

Private Sub test()
Debug.Print Now()
Call TimeWait(10)
Debug.Print Now()
'2010/01/09 17:22:16
'2010/01/09 17:22:26
End Sub

Wait メソッド

実行中のマクロを指定の時刻まで停止します。指定の時間に達した場合、True を返します。

重要 Wait メソッドは、Excel のすべての動作を停止させますが、印刷や再計算などのバックグラウンド処理は続行されます。

構文
expression.Wait(Time)
expression
必ず指定します。対象となる Application オブジェクトを表すオブジェクト式を指定します。
Time
必ず指定します。バリアント型 (Variant) の値を使用します。マクロを再開する時刻を Excel の日付の書式で指定します。

Wait メソッドの使用例

次の使用例は、実行中のマクロを当日の午後 6 時 23 分まで停止します。

Option Explicit

Application.Wait "18:23:00"

次の使用例は、実行中のマクロを約 10 秒間停止します。

Option Explicit

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

次の使用例は、10 秒を過ぎるとメッセージを表示します。

Option Explicit

If Application.Wait(Now + TimeValue("0:00:10")) Then
MsgBox "時間が過ぎました。"
End If

TimeValue 関数

時刻を表すバリアント型 (内部処理形式 Date の Variant) の値を返します。

構文
TimeValue(time)
引数
time
は必ず指定します。引数 time には、通常 0:00:00 (12:00:00 AM) ～ 23:59:59 (11:59:59 PM) の範囲の時刻を表す文字列式を指定します。また、この範囲で時刻を表す任意の式を指定することもできます。引数 time に Null 値が含まれると、Null 値を返します。
解説
12 時間制または24 時間制のどちらを使って時刻を指定してもかまいません。たとえば、"2:24PM" と "14:24" は、両方とも有効な引数となります。
引数 time が日付の値を含む場合、TimeValue 関数はその日付を戻り値に含めません。ただし、引数 time に正しくない値を指定したときには、エラーが発生します。

TimeValue 関数の使用例

次の例は、TimeValue 関数を使って、文字列を時刻に変換します。時刻リテラルを使って、バリアント型 (Variant) や日付型 (Date) の変数に時刻を直接代入することもできます。たとえば、MyTime = #4:35:17 PM# のように指定します。

Option Explicit

Dim MyTime
MyTime = TimeValue("4:35:17 PM") ' 時刻を返します。

日付時刻先月の第１日

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fnc先月の第1日(HIDUKE As Date) As String
'*******************************************************************************
'先月の第１日
'*******************************************************************************
fnc先月の第1日 = DateAdd("m", -1, DateSerial(Year(HIDUKE), Month(HIDUKE), 1))
End Function

日付時刻定義済み日付/時刻書式Format関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の表は、定義済み日付/時刻書式の名前とその内容を示します。
'
'書式名内容
'General Date 日付または時刻、あるいはその両方を返します。整数部と小数部の両方を含む数値を指定すると、日付と時刻の両方を表す文字列 (たとえば 96/4/3 5:34) に変換します。小数部がない場合には日付のみ (たとえば 96/4/3)、整数部がない場合には時刻のみ (たとえば 5:34) を表す文字列に変換します。日付と時刻の表示形式はコントロールパネルの設定により決まります。
'Long Date 日付の長い形式 (コントロールパネルの設定) で表した日付を返します。
'Medium Date 簡略形式で表した日付を返します。ホストアプリケーションで使用されます。
'Short Date 日付の短い形式 (コントロールパネルの設定) で表した日付を返します。
'Long Time 時刻、分、秒を含む形式で表した時刻を返します。
'Medium Time 時間と分を 12 時間制で表した時刻を返します。同時に午前 (AM)、午後 (PM) も追加します。
'Short Time 時間と分を 24 時間制で表した時刻 (たとえば 17:45) を返します。

日付時刻文字型にした1000分の1秒(日付・時間・付加)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function TimerStr() As String
'**********************************************
'文字型にした1000分の1秒
'**********************************************

'午前 0 時 (真夜中) から経過した秒数
'Int=Fix

TimerStr = Format(Int((CDbl(Timer) - Int(CDbl(Timer))) * 1000), "00#")

End Function

Private Sub test_TimerStr()
Dim i As Byte
For i = 1 To 10
Debug.Print TimerStr
Next i
'031
'031
'031
'031
'031
'031
'031
'031
End Sub

Function TimerTimeStr() As String
'**********************************************
'文字型にした1000分の1秒(時間・付加)
'**********************************************

'午前 0 時 (真夜中) から経過した秒数
'Int=Fix
Dim sTimer As String
sTimer = Format(Int((CDbl(Timer) - Int(CDbl(Timer))) * 1000), "00#")

TimerTimeStr = Format(Time, "hhmmss") & sTimer

End Function

Private Sub test_TimerTimeStr()
Dim i As Byte
For i = 1 To 10
Debug.Print TimerTimeStr
Next i
'073830906
'073830906
'073830906
'073830906
'073830921
'073830921
'073830921
'073830921
End Sub

Function TimerDateTimeStr() As String
'**********************************************
'文字型にした1000分の1秒(日付・時間・付加)
'**********************************************

'午前 0 時 (真夜中) から経過した秒数
'Int=Fix
Dim sTimer As String
sTimer = Format(Int((CDbl(Timer) - Int(CDbl(Timer))) * 1000), "00#")

TimerDateTimeStr = Format(Now, "yyyymmddhhmmss") & sTimer

End Function

Private Sub test_TimerDateTimeStr()
Dim i As Byte
For i = 1 To 10
Debug.Print TimerDateTimeStr
Next i
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252062
'20100111074252078
'20100111074252078
End Sub

Private Sub test()
Debug.Print Date    'Date 関数
Debug.Print Time    'Time 関数
Debug.Print Timer   'Timer 関数
Debug.Print Now     'Now 関数
'2010/01/11
'7:26:04
' 26764.08
'2010/01/11 7:26:04
End Sub

Timer 関数

午前 0 時 (真夜中) から経過した秒数を表す単精度浮動小数点数型 (Single) の値を返します。

構文
Timer
解説
Microsoft Windows では、Timer 関数は小数点以下の値も返します。Macintosh では、小数点以下の値は返されません。
Timer 関数の使用例
次の例は、Timer 関数を使って、プログラムの実行を中断します。この例では、DoEvents ステートメントを使って、プログラムが中断している間も他のプロセスを割り込みで処理できます。

Option Explicit

Private Sub test()
Dim PauseTime, Start, Finish, TotalTime, msg
msg = "[はい] をクリックすると、ﾌﾟﾛｸﾞﾗﾑの実行が 5 秒間中断されます。"
If (MsgBox(msg, 4)) = vbYes Then
    PauseTime = 5                ' 中断時間を設定します。
    Start = Timer                ' 中断の開始時刻を設定します。
    Do While Timer < Start + PauseTime
        DoEvents                 ' 他のプロセスに制御を渡します。
    Loop
    Finish = Timer               ' 中断の終了時刻を設定します。
    TotalTime = Finish - Start   ' 実際の中断時間を計算します。
    MsgBox "実行を " & TotalTime & " 秒間中断しました。"
    Debug.Print TotalTime
Else
    End
End If
End Sub

日付時刻表示書式指定文字の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の表は、日付と時刻の表示書式の指定例を示します。ただし、国別情報が日本語/日本に設定されているものと仮定します。また、日付は 1958 年 12 月 7 日、時刻は午後 8 時 50 分 35 秒であるものと仮定します。最後の例は、日付と時刻の両方を対象としています。
'
'指定した書式変換結果
'yy/mm/dd 58/12/07
'mm-d 12-7
'd-mmmm-yy 7-December-58
'd mmmm 7 December
'mmmm yy December 58
'ddddd(aaa) 58/12/07(日)
'dddddd 1958 年 12 月 7 日日曜日
'ggge年m月d日(aaaa) 昭和33年12月7日(日曜日)
'hh:mm AM/PM 08:50 PM
'h:mm:ss a/p 8:50:35 p
'h:mm 20:50
'h:mm:ss 20:50:35
'm/d/yy h:mm 12/7/58 20:50

日付時刻秒数や分数を時間や日付形式にするdd_hh:nn:ss

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function MakeTimeDateA(dblTime As Double) As String
'**********************************************
'秒数や分数を時間や日付形式にするdd_hh:nn:ss
'**********************************************
'引数dblTimeが秒の場合
'dd hh:nn:ss　形式の場合

    Dim Inds As Integer, Frms As String
    Dim Indn As Integer, Frmn As String
    Dim Indh As Integer, Frmh As String
    Dim Indd As Integer, Frmd As String

    Inds = dblTime Mod 60                '秒
    Indn = Round(dblTime \ 60) Mod 60    '分
    Indh = Round(dblTime \ 3600) Mod 24  '時
    Indd = Round(dblTime \ 86400)        '日

    Frms = Format(Inds, "0#")
    Frmn = Format(Indn, "0#")
    Frmh = Format(Indh, "0#")
    Frmd = Format(Indd, "0#")

MakeTimeDateA = Frmd & " " & Frmh & ":" & Frmn & ":" & Frms

'Mod 演算子
'2 つの数値の除算を行い､その剰余を返します｡
'
'構文
'
'result = number1 Mod number2
'
'Mod 演算子の構文は、次の指定項目から構成されます。
'
'指定項目   内容
'result     必ず指定    任意の数値変数を指定します｡
'number1    必ず指定    任意の数式を指定します｡
'number2    必ず指定    任意の数式を指定します｡
End Function

Private Sub testA()
Debug.Print MakeTimeDateA(86401)
Debug.Print MakeTimeDateA(86000)
Debug.Print MakeTimeDateA(8)
Debug.Print MakeTimeDateA(800000)
'返値
'01 00:00:01
'00 23:53:20
'00 00:00:08
'09 06:13:20
End Sub

Function MakeTimeDateB(dblTime As Double) As String
'**********************************************
'秒数や分数を時間や日付形式にするhh:nn:ss
'**********************************************
'引数dblTimeが秒の場合
'hh:nn:ss　形式の場合

    Dim Inds As Integer, Frms As String
    Dim Indn As Integer, Frmn As String
    Dim Indh As Integer, Frmh As String

    Inds = dblTime Mod 60                '秒
    Indn = Round(dblTime \ 60) Mod 60    '分
    Indh = Round(dblTime \ 3600)         '時

    Frms = Format(Inds, "0#")
    Frmn = Format(Indn, "0#")
    Frmh = Format(Indh, "0#")

MakeTimeDateB = Frmh & ":" & Frmn & ":" & Frms

End Function

Private Sub testB()
Debug.Print MakeTimeDateB(86401)
Debug.Print MakeTimeDateB(86000)
Debug.Print MakeTimeDateB(8)
Debug.Print MakeTimeDateB(800000)
'返値
'24:00:01
'23:53:20
'00:00:08
'222:13:20
End Sub

解説

剰余演算子は、数式 number1 を数式 number2 で除算し、その余りを演算結果 result として返します。このとき浮動小数点数は整数に丸められます。たとえば、次に示す式では、変数 A (演算結果 result) の値は 5 になります。

A = 19 Mod 6.7

通常、演算結果 result のデータ型は、result の値が整数であるかどうかに関係なく、バイト型 (Byte)、整数型 (Integer)、または長整数型 (Long)、あるいは、内部処理形式がバイト型、整数型、または長整数型のバリアント型 (Variant) になります。小数部分はすべて切り捨てられます。ただし、一方または両方の式が Null 値のときは、演算結果 result も Null 値になります。Empty 値を持つ式は、0 として扱われます。

日付時刻曜日や時間間隔・日付間隔の取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub 曜日Weekday()
'*******************************************************************************
'曜日【Weekday(Date)】Weekday 関数
'*******************************************************************************
'指定された日付の曜日を取得します。
    MsgBox Weekday(Date)
    MsgBox Weekday(Date + 1)
'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜
End Sub

Sub 曜日()
'*******************************************************************************
'曜日【WeekdayName(Weekday(Date), False)】WeekdayName 関数
'*******************************************************************************
'指定された曜日を表す文字列を返します。
    MsgBox WeekdayName(Weekday(Date), False)    '曜日あり
    MsgBox WeekdayName(Weekday(Date), True)     '曜日なし
'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜
End Sub

Sub 日付間隔()
'*******************************************************************************
'日付間隔【DateDiff("d", 開始日, 終了日)】DateDiff 関数
'*******************************************************************************
'指定された日付までの日数を取得します。
    Const 開始日 = "2000/01/01"
    Const 終了日 = "2000/12/31"
     MsgBox DateDiff("yyyy", 開始日, 終了日) & "年" & vbCr & _
            DateDiff("q", 開始日, 終了日) & "四半期" & vbCr & _
            DateDiff("M", 開始日, 終了日) & "月" & vbCr & _
            DateDiff("y", 開始日, 終了日) & "年間通算日" & vbCr & _
            DateDiff("d", 開始日, 終了日) & "日" & vbCr & _
            DateDiff("w", 開始日, 終了日) & "週日" & vbCr & _
            DateDiff("ww", 開始日, 終了日) & "週" & vbCr & _
            DateDiff("h", 開始日, 終了日) & "時" & vbCr & _
            DateDiff("n", 開始日, 終了日) & "分" & vbCr & _
            DateDiff("s", 開始日, 終了日) & "秒"
'設定値
'-----------------------------------------------------
'設定値内容
'yyyy   年
'q      四半期
'm      月
'y      年間通算日
'd      日
'w      週日
'ww     週
'h      時
'n      分
's      秒

'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜

'定数               値内容
'vbUseSystem        0 NLS API の設定値を使います。
'vbFirstJan1        1 (既定値)1月1日を含む週を年度の第1週として扱います。
'vbFirstFourDays    2 7日のうち少なくとも4日が新年度に含まれる週を年度の
'                     第1週として扱います。
'vbFirstFullWeek    3 全体が新年度に含まれる最初の週を年度の第1週として扱います。

End Sub

Sub 経過時間()
'*******************************************************************************
'経過時間【DatePart("h", Time)】DatePart 関数
'*******************************************************************************
'指定の日付や時間などが該当値からいくら経過したかを求めます。
    MsgBox "今月" & DatePart("w", Date) & "週経過"
    MsgBox "今年" & DatePart("y", Date) & "日経過"
    MsgBox "今月" & DatePart("d", Date) & "日経過"
    MsgBox "今日" & DatePart("h", Time) & "時間経過"
'設定値
'-----------------------------------------------------
'設定値内容
'yyyy   年
'q      四半期
'm      月
'y      年間通算日
'd      日
'w      週日
'ww     週
'h      時
'n      分
's      秒

'定数           値  内容
'vbUseSystem    0   NLS API の設定値を使います。
'vbSunday       1   日曜(既定値)
'vbMonday       2   月曜
'vbTuesday      3   火曜
'vbWednesday    4   水曜
'vbThursday     5   木曜
'vbFriday       6   金曜
'vbSaturday     7   土曜

'定数               値内容
'vbUseSystem        0 NLS API の設定値を使います。
'vbFirstJan1        1 (既定値)1月1日を含む週を年度の第1週として扱います。
'vbFirstFourDays    2 7日のうち少なくとも4日が新年度に含まれる週を年度の
'                     第1週として扱います。
'vbFirstFullWeek    3 全体が新年度に含まれる最初の週を年度の第1週として扱います。

End Sub

Sub 時間間隔()
'*******************************************************************************
'時間間隔【DateAdd("ww", 4, 起算日)】DateAdd 関数
'*******************************************************************************
'加算後の日付や時間を表示します。
    MsgBox "今日から4週間：後" & Format(DateAdd("ww", 4, Date), "yyyy年m月d日")
    MsgBox "今日から10日前：" & Format(DateAdd("d", -10, Date), "yyyy年m月d日")
    MsgBox "今から20分後：" & Format(DateAdd("n", 20, Time), "h時m分")
'設定値
'-----------------------------------------------------
'設定値内容
'yyyy   年
'q      四半期
'm      月
'y      年間通算日
'd      日
'w      週日
'ww     週
'h      時
'n      分
's      秒
End Sub

Sub 文字列変換日付()
'*******************************************************************************
'文字列変換日付【DateValue（日付）】DateValue 関数
'*******************************************************************************
'文字列を日付に変換します。
MsgBox DateValue("Ｓ13年12月30日")
End Sub

Sub 文字列変換時刻()
'*******************************************************************************
'文字列変換時刻【TimeValue（時刻）】TimeValue 関数
'*******************************************************************************
'文字列を時刻に変換します。
MsgBox TimeValue("13時54分")
End Sub

日付時刻保存名を作成する現在年月日時刻を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function 保存名作成() As String
'*******************************************************************************
'保存名を作成する現在年月日時刻を取得
'*******************************************************************************
保存名作成 = Format(Now, "-yy年mm月dd日hh時mm分ss秒")
End Function

日付時刻曜日を表す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Me("textbox" & 4).Value = WeekdayName(Weekday(Date, vbSunday))

変数変数と定数に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'値の代入 Let
'変数または定数の宣言 Const, Dim, Private, Public, New, Static
'プライベートモジュールの宣言 Option Private Module
'バリアント型に関する情報を取得 IsArray, IsDate, IsEmpty, IsError, IsMissing, IsNull, IsNumeric, IsObject, TypeName, VarType
'現在のオブジェクトの参照 Me
'変数の明示的な宣言を要求 Option Explicit
'既定のデータ型の設定 Deftype

変数重複しない乱数取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub 重複しない乱数取得()
'*************************************
'重複しない乱数取得
'英字を付加したい場合及び数値のみ対応
'数値の範囲指定可能
'任意作成数
'*************************************

Dim RNDADD() As String '←出来た格納変数(グローバル変数へ)

Dim 乱数最低値 As Long, 乱数最高値 As Long
Dim 作成数 As Long
Dim MyValue, a As Long, b As Long, i As Long

乱数最低値 = 1000000: 乱数最高値 = 9999999
作成数 = 10

'英字をつけない場合のエラー回避
If (乱数最高値 - 乱数最低値) + 1 < 作成数 Then
    MsgBox "作成範囲", 0, "ERROR"
Exit Sub
End If

For a = 1 To 作成数
    ReDim Preserve RNDADD(i)
再試行:
    MyValue = Int((乱数最高値 * Rnd) + 乱数最低値)
    '*英字を付加したい場合は↓を追加
    MyValue = ランダム英字取得 & ランダム英字取得 & ランダム英字取得 & MyValue
        For b = LBound(RNDADD) To UBound(RNDADD)
            '作成済みと重複していたら
            If RNDADD(b) = MyValue Then GoTo 再試行:
        Next b
    RNDADD(i) = MyValue
    MsgBox RNDADD(i) '確認用MSG(削除)

    i = i + 1
Next a

End Sub

Private Function ランダム英字取得() As String
'*********************************************
'ランダム英字取得関数
'*********************************************
Dim MyValue, str(26) As String
MyValue = Int((26 * Rnd) + 1)
    str(1) = "a":  str(9) = "i": str(17) = "q": str(25) = "y"
    str(2) = "b": str(10) = "j": str(18) = "r": str(26) = "z"
    str(3) = "c": str(11) = "k": str(19) = "s"
    str(4) = "d": str(12) = "l": str(20) = "t"
    str(5) = "e": str(13) = "m": str(21) = "u"
    str(6) = "f": str(14) = "n": str(22) = "v"
    str(7) = "g": str(15) = "o": str(23) = "w"
    str(8) = "h": str(16) = "p": str(24) = "x"
ランダム英字取得 = str(MyValue)
End Function

Private Sub test1()
MsgBox ランダム英字取得
End Sub

変数変数だけでソート（並び替え）昇順降順

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub test()
'*************************************
'変数だけでソート（並び替え）昇順降順
'*************************************

Dim i As Byte, str As String
Dim testData() As Long
ReDim testData(10) As Long
testData(1) = 3
testData(2) = 7
testData(3) = 1
testData(4) = 9
testData(5) = 2
testData(6) = 5
testData(7) = 8
testData(8) = 4
testData(9) = 6
testData(10) = 0

VariableSortAsc testData
str = ""
For i = 1 To 10
str = str & i & vbTab & testData(i) & vbCr
Next i
MsgBox str

ReDim testData(10) As Long

testData(1) = 3
testData(2) = 7
testData(3) = 1
testData(4) = 9
testData(5) = 2
testData(6) = 5
testData(7) = 8
testData(8) = 4
testData(9) = 6
testData(10) = 0

VariableSortDes testData
str = ""
For i = 1 To 10
str = str & i & vbTab & testData(i) & vbCr
Next i
MsgBox str
End Sub

Sub VariableSortAsc(lngData As Variant)
'*************************************
'変数だけでソート（並び替え）昇順
'*************************************
'Ascending order 昇順
'１次元用
Dim MainSort As Long
Dim SubSort As Long
Dim lngChange As Long

    For MainSort = LBound(lngData) To UBound(lngData)
        For SubSort = UBound(lngData) To MainSort Step -1
            If lngData(MainSort) > lngData(SubSort) Then
                lngChange = lngData(MainSort)
                lngData(MainSort) = lngData(SubSort)
                lngData(SubSort) = lngChange
            End If
        Next SubSort
    Next MainSort

End Sub

Sub VariableSortDes(lngData As Variant)
'*************************************
'変数だけでソート（並び替え）降順
'*************************************
'Descending order 降順
'１次元用
Dim MainSort As Long
Dim SubSort As Long
Dim lngChange As Long

    For SubSort = UBound(lngData) To MainSort Step -1
        For MainSort = LBound(lngData) To UBound(lngData)
                If lngData(MainSort) < lngData(SubSort) Then
                    lngChange = lngData(MainSort)
                    lngData(MainSort) = lngData(SubSort)
                    lngData(SubSort) = lngChange
                End If
        Next MainSort
    Next SubSort

End Sub

変数型宣言文字

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub 型宣言文字()
'****************************
'型宣言文字
'****************************
'変数を宣言
Dim NullVar, MyType$, StrVar$, IntVar%, CurVar@
Dim ArrayVar&(1 To 5), dbl#

MyType = TypeName(StrVar)       ' "String" を返します。
MsgBox MyType
MyType = TypeName(IntVar)       ' "Integer" を返します。
MsgBox MyType
MyType = TypeName(CurVar)       ' "Currency" を返します。
MsgBox MyType
MyType = TypeName(NullVar)      ' "Single" を返します。
MsgBox MyType
MyType = TypeName(ArrayVar)     ' "Long()" を返します。
MsgBox MyType
MyType = TypeName(dbl)          ' "Double" を返します。
MsgBox MyType

'Integer    %
'Long       &
'Single
'Double     #
'String     $
'Currency   @
End Sub

'解説
'元々Basic言語(ベーシック)にはVariant(バリアント型)なるものは存在しなかった。
'Variant(バリアント型)の登場でVB関数の中にはString(文字列型)と新しく登場した
'Variant(バリアント型)を返すものがある。
'変数は宣言すると宣言された型の容量を確保する、よってVariant(バリアント型)
'が必要ない場合は容量の少ないString(文字列型)で返してやるほうがメモリー消費は少ない。

Private Sub test01()
'***************************
'関数の返す値の型を指定する
'***************************

'指定した文字コードに対応する文字を返します。
MsgBox Chr$(65)
'データをバイトデータとして扱う
MsgBox ChrB$(65)
'現在のパスを求めます
MsgBox CurDir$("C")
'現在んお日付を求めます
MsgBox Date$
'ファイルの存在又はファイル名を求めます。
MsgBox Dir$("C:\WINDOWS\WIN.INI")
'エラーメッセージを求めます。
MsgBox Error$(61)
'フォーマットします。
MsgBox Format$("1", "0000#")
'値を16進数で表します
MsgBox Hex$(100)
'ファイルから 1 文字ずつ読み込んでいます
Dim MyChar
Open "TESTFILE" For Input As #1 ' ファイルを開きます。
Do While Not EOF(1)             ' ファイルの終端までループを繰り返します。
    MyChar = Input$(1, #1)      ' 1 文字のデータを読み込みます。
    Debug.Print MyChar          ' イミディエイトウィンドウに表示します。
Loop
Close #1
'テキストファイルに含まれているバイトデータを読み込む
Open "TESTFILE" For Input As #1 ' ファイルを開きます。
Do While Not EOF(1)             ' ファイルの終端までループを繰り返します。
    MyChar = InputB$(1, #1)     ' 1 文字のデータを読み込みます。
    Debug.Print MyChar          ' イミディエイトウィンドウに表示します。
Loop
Close #1
'アルファベットの大文字を小文字に変換する
MsgBox LCase$("ABCDE")
'文字列の左端から指定した文字数分の文字列を返します
MsgBox Left$("ABCDE", 2)
'文字列の左端から指定したバイト数分の文字列を取り出します
MsgBox LeftB$("ABCDE", 2)
'先頭のスペースを削除した文字列を表す値を返します。
MsgBox LTrim$(" ABCDE ")
'文字列から指定した文字数分の文字列を返します
MsgBox Mid$("ABCDE", 1, 2)
'文字列から指定したバイト数分の文字列を返します
MsgBox MidB$("ABCDE", 1, 2)
'引数に指定した値を 8 進数で表すの値を返します。
MsgBox Oct$(459)
'文字列の右端から指定した文字数分の文字列を返します
MsgBox Right$("ABCDE", 2)
'文字列の右端から指定したバイト数分の文字列を取り出します
MsgBox RightB$("ABCDE", 2)
'末尾のスペース削除した文字列を表す値を返します。
MsgBox RTrim$(" ABCDE ")
' 2 つの文字列の間にスペースを 10 個挿入します。
MsgBox "AB" & Space(10) & "CDE"
'数式の値を文字列で表した値 (数字) で返す
MsgBox Str$(11122)
'現在の時刻を求めます
MsgBox Time$
'先頭と末尾の両方のスペース削除した文字列を表す値を返します。
MsgBox Trim$(" ABCDE ")
'アルファベットの小文字を大文字に変換する
MsgBox UCase$("abcdef")

End Sub

変数可変長文字列と固定長文字列-As_String_*_5

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub VariableFixedString()
'*******************************************
'可変長文字列と固定長文字列-As_String_*_5
'*******************************************
'アスタリスク

Dim strST  As String        '可変長文字列宣言
Dim strST3 As String * 3    '固定長文字列宣言（３文字）
Dim strST5 As String * 5    '固定長文字列宣言（５文字）
Dim strST7 As String * 7    '固定長文字列宣言（７文字）

strST = "12345678"
strST3 = strST
strST5 = strST
strST7 = strST

Debug.Print strST
Debug.Print strST3
Debug.Print strST5
Debug.Print strST7

'strST  =12345678
'strST3 =123
'strST5 =12345
'strST7 =1234567

'固定長文字列宣言する場合Stringの後にアスタリスク（*）とその数値を付加する

End Sub

変数型文字・リテラルの型文字(時短に便利)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'宣言ステートメントでデータ型を指定するだけでなく、"型文字" を使用してプログラミング要素のデータ型を強制的に指定することもできます。
'型文字は要素名の直後に指定する必要があります｡間にはどのような文字も指定しないでください｡
'
'型文字は要素名には含まれません｡型文字を使用して定義した要素を参照するときには､型文字を省略できます｡
'
'識別子の型文字
'Visual Basic には "識別子の型文字" が用意されています。
'この型文字は､変数または定数のデータ型を指定するために宣言で使用できます｡次の表は､使用できる識別子の型文字とその使用例を示しています｡
'
'識別子の型文字     データ型                    例
'
'    %                整数型 (Integer)      Dim L%
'
'    &              長整数型 (Long)      Public M&
'
'    @               10 進型 (Decimal)    Const W@ = 37.5
'
'       単精度浮動小数点数型 (Single)       Dim Q
'
'    #  倍精度浮動小数点数型 (Double)    Static X#
'
'    $              文字列型 (String)   Private V$ = "Secret"
'
'
'ブール型 (Boolean)、バイト型 (Byte)、char 型 (Char)、日付型 (Date)、オブジェクト型 (Object)、
'または短整数型 (Short) の各データ型および複合データ型に対応する識別子の型文字はありません。
'
'識別子の型文字を使用して､ほかの識別子のデータ型を強制的に指定することもできます｡
'また、式でも使用できます。場合によっては、Left ではなく Left$ のように、$ 文字を Visual Basic の関数に追加できます。
'
'いずれの場合でも､識別子の型文字は識別子の直後に指定する必要があります｡
'
'リテラルの型文字
'
'"リテラル" は、ある型の特定の値のテキスト表現です。
'通常､コード内のリテラルの形式によってそのコードのデータ型が決まります｡
'コンパイラでは、整数型リテラルはサイズが長整数型 (Long) に相当しない限り整数型 (Integer) として扱われ、
'整数型でないリテラルは倍精度浮動小数点数型 (Double) として扱われます。次のステートメントでは、リテラルのデータ型が明らかです。

j = 347    ' This literal is of the Integer data type.
X = 9.2    ' This literal is of the Double data type.
B = False  ' This literal is of the Boolean data type.

'Visual Basic には、"リテラルの型文字" が用意されています。
'この型文字を使用すると､あるリテラルに対して､そのリテラルの形式が示す以外のデータ型を指定できます｡
'このためには､リテラルの型文字をリテラルの最後に付けます｡次の表は､使用できるリテラルの型文字とその使用例を示しています｡
'
'リテラルの型文字             データ型                  例
'
'             S               短整数型 (Short)        I = 347S
'
'             I                 整数型 (Integer)      J = 347I
'
'             L               長整数型 (Long)         K = 347L
'
'             D                10 進型 (Decimal)      H = 347D
'
'             F   単精度浮動小数点数型 (Single)       Y = 347F
'
'             R   倍精度浮動小数点数型 (Double)       Z = 347R
'
'             C                char 型 (Char)         Q = "."C
'
'
'ブール型 (Boolean)、バイト型 (Byte)、日付型 (Date)、オブジェクト型 (Object)、
'または文字列型 (String) の各データ型および複合データ型に対応するリテラルの型文字はありません。
'
'リテラルには、変数、定数、および式と同様に、識別子の型文字 (%、&、@、、#、$) を使用できます。
'ただし、リテラルの型文字 (S、I、L、D、F、R、C) が使用できるのはリテラルだけです。
'
'いずれの場合でも､リテラルの型文字はリテラルの直後に指定する必要があります｡
'

変数 Objectを変数にした例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub UserForm_Click()
    '{Just a moment}の表示------------------->
    Dim bytLabelstr As Long
    Dim objME As Object
    Dim MeMax As Long
    Dim MeNow As Long
    MeMax = 100000

    Set objME = Me.Label1
    For MeNow = 1 To MeMax
    bytLabelstr = bytLabelstr + 1
    If bytLabelstr = 4000 Then
    bytLabelstr = 0
    End If
    If bytLabelstr <= 2000 Then
    objME.Caption = ""
    DoEvents
    Else
    objME.Caption = "Just a moment  "
    DoEvents
    End If
    If MeNow = MeMax Then objME.Caption = ""
    Next MeNow
    Set objME = Nothing
    '{Just a moment}の表示------------------->

End Sub

変数 Newキーワード変数宣言のいろいろ

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'省略可能です｡
'このキーワードを指定すると､オブジェクトを暗黙的に作成できます｡
'オブジェクト変数を宣言するときにキーワード New を指定した場合は､
'オブジェクトを最初に参照したときにオブジェクトの新しいインスタンスが作成されるので､
'Set ステートメントを使ってオブジェクトへの参照を代入する必要はありません。
'キーワード New を使って､固有のデータ型の変数の宣言､
'または従属オブジェクトのインスタンスの宣言はできません｡
'また、キーワード New は、キーワード WithEvents と共に使用できません。
'-----------------------------------------------------------------------------------
'Dim ステートメント
'
'Dim ステートメントの使用例
'次の例は、Dim ステートメントを使って、変数や配列を宣言する方法です。配列の添字の最小値は既定値では 0 ですが、
'Option Base ステートメントを使えば、モジュールレベルで変更できます。

' 変数 AnyValue と変数 MyValue は既定のバリアント型 (Variant)
' として宣言されて、値は Empty 値が設定されます。
Dim AnyValue, MyValue

' 整数型 (Integer) の変数を明示的に宣言します。
Dim Number As Integer

' 1 行で複数の変数を宣言します。型が指定されていないので、
' 変数 AnotherVar はバリアント型になります。
Dim AnotherVar, Choice As Boolean, BirthDate As Date

' 変数 DayArray は、要素数 51 のバリアント型配列として宣言されます。
' 現在のモジュールで、Option Base に既定値の 0 が設定されていれば、
' 添字の範囲は、0 ～ 50 になります。
Dim DayArray(50)

' 変数 Matrix は、整数型の 2 次元配列です。
Dim Matrix(3, 4) As Integer

' MyMatrix は、倍精度浮動小数点数型 (Double) の 3 次元配列です。
' 添字の範囲を、明示的に指定しています。
Dim MyMatrix(1 To 5, 4 To 9, 3 To 5) As Double

' BirthDay は、添字が 1 ～ 10 の範囲の日付型 (Date) の配列です。
Dim BirthDay(1 To 10) As Date

' MyArray は、バリアント型の動的配列です。
Dim MyArray()

'-----------------------------------------------------------------------------------
'Private ステートメント
'
'Private ステートメントの使用例
'次の例では、Private ステートメントをモジュールレベルで使って、変数をプライベートとして宣言しています。
'このような変数は､宣言を行っているモジュール内でのみ使用可能となります｡

Private Number As Integer    ' 整数型の変数をプライベートにします。
Private NameArray(1 To 5) As String
                            ' 配列変数をプライベートにします。
' 1 行で複数の変数を宣言します。
' 2 つのバリアント型変数と 1 つの整数型変数がすべてプライベートになります。
Private MyVar, YourVar, ThisVar As Integer

'-----------------------------------------------------------------------------------
'Public ステートメント
'
'Public ステートメントの使用例
'次の例では、標準モジュールのモジュールレベル (宣言セクション) で、Public ステートメントを使って、
'変数を明示的にパブリックとして宣言します。このように宣言された変数は、Option Private Module が有効でない限り、
'すべてのアプリケーションの全モジュールの全プロシージャから使うことができます｡

Public Number As Integer        ' 整数型変数をパブリックにします。
Public NameArray(1 To 5) As String
                                ' 配列変数をパブリックにします。
' 1 行で複数の変数を宣言します。
' 2 つのバリアント型変数と 1 つの整数型変数がすべてパブリックになります。
Public MyVar, YourVar, ThisVar As Integer

'-----------------------------------------------------------------------------------
'Set ステートメント
'
'Set ステートメントの使用例
'次の例では､Set ステートメントを使って､オブジェクトへの参照を変数に代入します｡
'YourObject は、Text プロパティを持つ有効なオブジェクトであるとします。

Dim YourObject, MyObject, MyStr
Set MyObject = YourObject    ' オブジェクトへの参照を代入します。
' MyObject と YourObject は、同一のオブジェクトを参照します。
YourObject.Text = "Hello World"    ' プロパティを初期化します。
MyStr = MyObject.Text        ' Hello World" を返します。

' 関連付けを解除します。MyObject は、YourObject を参照しなくなります。
Set MyObject = Nothing        ' オブジェクトを解放します。

'-----------------------------------------------------------------------------------
'Static ステートメント
'
'Static ステートメントの使用例
'次の例では、Static ステートメントを使って、モジュールコードが実行されている間、変数の値を保持します。

' 関数を定義します。
Function KeepTotal(Number)
    ' 次にこの関数が呼び出されるときまで値が保持されるのは、
    ' 変数 Accumulate だけです。
    Static Accumulate
    Accumulate = Accumulate + Number
    KeepTotal = Accumulate
End Function

' Static ステートメントを使って関数を定義します。
Static Function MyFunction(Arg1, Arg2, Arg3)
    ' すべてのローカル変数の値は、この関数が次に呼び出されるときまで
    ' 保持されます。
    Accumulate = Arg1 + Arg2 + Arg3
    Half = Accumulate / 2
    MyFunction = Half
End Function

変数 HEX(16進数)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub Hex逆変換()
Const Hex文字 = "%83%7A%81%5B%83%80%83%79%81%5B%83%57%56%45%52%31%30%2E%31"
Debug.Print Hex逆変換関数(Hex文字)
End Sub

Function Hex逆変換関数(ByVal 対象文字 As String) As String
Dim 変換文字() As Byte, 実行数 As Long
実行数 = 0
Do While Len(対象文字) > 0
If Left(対象文字, 1) = "%" Then
ReDim Preserve 変換文字(0 To 実行数)
変換文字(実行数) = Val("&H" & Mid(対象文字, 2, 2)) '基数を示すプリフィックス &O (8 進数) や &H (16 進数) は認識
対象文字 = Right(対象文字, Len(対象文字) - 3)
実行数 = 実行数 + 1
End If
Loop
Hex逆変換関数 = StrConv(変換文字, vbUnicode) '文字列を Unicode に変換
End Function

Sub Hex変換()
Const 文字 As String = "ホームページVER10.1" '定数宣言
Debug.Print Hex変換関数(文字)
End Sub

Function Hex変換関数(ByVal 対象文字 As String)
Dim 変換文字() As Byte, 実行数 As Long
変換文字 = StrConv(対象文字, vbFromUnicode) '文字列を Unicode に変換
For 実行数 = 0 To UBound(変換文字) '配列の指定された次元で使用できる添字の最大値
Hex変換関数 = Hex変換関数 & "%" & Hex(変換文字(実行数))
Next
End Function

変数 Hex関数日本語をHex文字に変換

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit
'Hex関数
'**************************************************
'サイト等で良く使われる関数(%)に変換又はその逆変換
'===========================================================================

'*****************************************
'Hex関数日本語をHex文字に変換
'*****************************************

Sub test1()
Const 文字 As String = "ホームページVER10.1" '定数宣言
Debug.Print Hex変換関数(文字)
    MsgBox Hex変換関数(文字)
End Sub

Function Hex変換関数(ByVal 対象文字 As String)
'*****************************************
'Hex関数日本語をHex文字に変換
'*****************************************
Dim 変換文字() As Byte, 実行数 As Long
    変換文字 = StrConv(対象文字, vbFromUnicode) '文字列を Unicode に変換

        For 実行数 = 0 To UBound(変換文字) '配列の指定された次元で使用できる添字の最大値
            Hex変換関数 = Hex変換関数 & "%" & Hex(変換文字(実行数))
        Next
End Function

'--------------------------------------------------------------------------

'*****************************************
'Hex関数 Hex文字を日本語に変換
'*****************************************

Sub test2()
Const Hex文字 = "%83%7A%81%5B%83%80%83%79%81%5B%83%57%56%45%52%31%30%2E%31"
Debug.Print Hex逆変換関数(Hex文字)
    MsgBox Hex逆変換関数(Hex文字)
End Sub

Function Hex逆変換関数(ByVal 対象文字 As String) As String
'*****************************************
'Hex関数 Hex文字を日本語に変換
'*****************************************
Dim 変換文字() As Byte, 実行数 As Long
    実行数 = 0
        Do While Len(対象文字) > 0
            If Left(対象文字, 1) = "%" Then
                ReDim Preserve 変換文字(0 To 実行数)
                '基数を示すプリフィックス &O (8 進数) や &H (16 進数) は認識
                変換文字(実行数) = Val("&H" & Mid(対象文字, 2, 2))
                対象文字 = Right(対象文字, Len(対象文字) - 3)
                実行数 = 実行数 + 1
            End If
        Loop
    Hex逆変換関数 = StrConv(変換文字, vbUnicode) '文字列を Unicode に変換
End Function

変数 Typeステートメント構造体「ユーザー定義型」

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'******************************************
'Typeステートメント構造体「ユーザー定義型」
'******************************************
'Class概念

' 構造体使用例

'Type ステートメント
'1 つまたは複数の要素を持つユーザー定義型を宣言します。
'クラスモジュールで使用する場合はPrivate を付ける必要があります。
'モジュールレベルで使います。

Type UserDefinition
'*****************************************
'ユーザー定義型を作成-Typeステートメント
'*****************************************
'データ型定義のファーマット化

    bytValue    As Byte         'データ型を定義。
    intValue    As Integer
    lngValue    As Long
    dblValue    As Double
    StrValue    As String

End Type

Sub 処理A()
'**********************************************
'ユーザー定義型Typeステートメントを使い値を代入
'**********************************************

    Dim 変数 As UserDefinition  '変数を宣言します。

    'プロシージャ内に記述。
    変数.bytValue = 1           '要素に値を代入。
    変数.intValue = 256
    変数.lngValue = 65536
    変数.dblValue = 123.12
    変数.StrValue = "ABC"
    '～～～～～～～～～～～～
    '～～～～～処理～～～～～
    '～～～～～～～～～～～～
    MsgBox 変数.intValue

End Sub

Sub shoriA()
'**********************************************
'通常のデータ型を定義して値を代入
'**********************************************

Dim Value1 As Byte              'データ型を定義。
Dim Value2 As Integer
Dim Value3 As Long
Dim Value4 As Double
Dim Value5 As String

    Value1 = 1                  '要素に値を代入。
    Value2 = 256
    Value3 = 65536
    Value4 = 123.12
    Value5 = "ABC"
    '～～～～～～～～～～～～
    '～～～～～処理～～～～～
    '～～～～～～～～～～～～
    MsgBox Value2

End Sub

'処理AとshoriAは同じ処理をしています。
'似たような定義が無い場合はどちらを使用しても手間は同じですが
'似たような定義が沢山必要なプロシージャがある場合はTypeステートメントが便利。
'例えば処理Aのような処理が処理BCDE・・・とあるような場合は便利です。

変数 ReDimステートメント(ヘルプ抜粋)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'動的配列変数に対するメモリ領域の再割り当てを行う｡プロシージャレベルで使用｡
'
'●構文 ReDim [Preserve] varname(subscripts) [As type] [, varname(subscripts) [As type]] . . .
'
'Preserve 省略可既存の配列に格納されている値を失うことなく、配列の最後の次元の要素数を変更する場合に使用する、キーワードです。
'varname 必須宣言する変数の名前です。変数の標準的な名前付け規則に従って指定します。
'subscripts 必須配列変数の次元を指定します。指定できる次元数の最大値は 60 です。
'
'[lower To] upper [,[lower To] upper] . . .
'
'引数 lower を省略した場合、配列の添字の最小値は Option Base ステートメントによって制御されます。
'Option Base ステートメントが記述されていなければ、添字の最小値は 0 になります。
'type 省略可変数のデータ型を指定。
'バイト型 (Byte) ブール型 (Boolean) 整数型 (Integer) 長整数型 (Long) 通貨型 (Currency)
'単精度浮動小数点数型 (Single) 倍精度浮動小数点数型 (Double) 日付型 (Date) 文字列型 (String) (可変長の場合は String、
'固定長の場合は String * length)
'オブジェクト型 (Object) バリアント型 (Variant) ユーザー定義型、またはオブジェクト 10 進型 (Decimal) (現在はサポートされていません)
'の種類のいずれかを指定できます。As type 節は、宣言する各変数に対して個別に指定します。
'バリアント型 (Variant) で配列を格納する場合、引数 type で指定するのは配列の各要素のデータ型です。
'この引数でバリアント型をほかのデータ型に変えることはできません｡
'
'●解説
' ReDim ステートメントは、動的配列を宣言したり、Private、Public、または Dim の各ステートメントにおいて、
'次元の添字を省略した空のかっこだけを指定して宣言されている動的配列の､要素数や次元数を変更するときに使います｡
' ReDim ステートメントは、配列の要素数や次元数を変更するために何回でも使うことができます。
'ただし、バリアント型 (Variant) に格納されている配列を除き、
'一度あるデータ型で宣言された配列のデータ型を ReDim ステートメントで別のデータ型に変更することはできません。
'配列がバリアント型に格納されている場合、As type 節を使用して要素のデータ型を変更できます。
'ただし、キーワード Preserve を使用している場合は、データ型の変更は許可されません。
' キーワード Preserve を指定した場合、変更できるのは、動的配列の最後の次元のサイズに限られます。
'また、次元数は変更できません。たとえば、次元が 1 つしかない動的配列の場合、
'その次元は最後のただ 1 つの次元なので、その次元のサイズを変更できます。
'次元が 2 つ以上ある動的配列の場合、最後の次元のサイズのみを変更でき、その配列に格納されている値は保持されます。
'ただし､ほかの次元の大きさは変更できません｡次の例では､既に格納されている値を保持したまま､
'動的配列の最後の次元のサイズを増やします｡
'
'ReDim X(10, 10, 10). . .

ReDim Preserve X(10, 10, 15)

' 同様に、キーワード Preserve を使用した場合、動的配列のサイズを変更するために変えられるのは、
'添字の上限だけです｡添字の下限を変更しようとすると､エラーが発生します｡
' 配列のサイズを小さくすると､削除された配列の要素に格納されていた値は､
'失われます｡プロシージャに配列を参照渡しで引き渡した場合､プロシージャ内で配列の再定義を行うことはできません｡
' 変数の初期化時には、数値変数は 0 に、
'可変長文字列は長さ 0 の文字列 ("") に初期化されて、固定長文字列には 0 が埋められます。
'また、バリアント型 (Variant) 変数は Empty 値に初期化されます。ユーザー定義型変数の各要素は、個別の変数として初期化されます。
'オブジェクトを参照する変数には、あらかじめ Set ステートメントで既存のオブジェクトを代入しておく必要があります。
'既存のオブジェクトを代入するまで、オブジェクト変数には、特殊な値である Nothing が格納されています。
'これは､オブジェクト変数がオブジェクトの特定のインスタンスを参照していないことを表す値です｡
'
'●備考
' 宣言した変数がモジュールレベルまたはプロシージャレベルにない場合、ReDim ステートメントは宣言ステートメントと同様の働きをします。
'同じ名前を持つほかの変数が後で作成されると、その変数の適用範囲 (スコープ) が広く、
'Option Explicit ステートメントが指定されている場合でも、ReDim ステートメントは後で作成された変数を参照し、
'コンパイルエラーは発生しません｡このような名前の競合を避けるには､
'ReDim ステートメントは宣言ステートメントとして使わず、配列を再定義するためだけに使用します。
' バリアント型 (Variant) に格納された配列のサイズを変更するには、まず最初にバリアント型変数を明示的に宣言する必要があります。
'
'●使用例
'ReDim ステートメントを使って、動的配列変数を保存するメモリ領域の割り当てと再割り当てを行います。
'Option Base ステートメントには、1 が設定されているものとします。

Dim MyArray() As Integer ' 動的配列を宣言します。
ReDim MyArray(5) ' 5 要素分の領域を割り当てます。
For i = 1 To 5 ' 5 回、ループします。
MyArray(i) = i ' 配列を初期化します。
Next i
次のステートメントは､配列のサイズを変更して､以前の要素を消去します｡

ReDim MyArray(10) ' 配列の要素数を 10 に変更します。
For i = 1 To 10 ' 10 回、ループします。
MyArray(i) = i ' 配列を初期化します。
Next i
次のステートメントでは､以前の要素を消去せずに､配列のサイズを変更します｡

ReDim Preserve MyArray(15)
' 配列の要素数を 15 に変更します。

変数グローバル変数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public strA As String
Public strB As String

連携 Runメソッド関数マクロを呼び出します

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の使用例は､MYCUSTOM.XLM というマクロシートで定義されている､
'My_Func_Sum という関数マクロを呼び出します｡
'マクロシートは開かれている必要があります｡
'この関数には 2 つの数値引数があり、次の使用例では 1 と 5 が渡されます。
'
mySum = Application.Run("MYCUSTOM.XLM My_Func_Sum", 1, 5)
MsgBox "マクロの結果: " & mySum
'
'Runメソッド
'
'構文 1 では、マクロの実行または関数の呼び出しを行います。
'この構文では、Visual Basic、または Excel 4.0 マクロ言語で書かれたマクロ、
'あるいは、DLL や XLL に含まれる関数が実行できます。
'
'構文 2 では、指定されたセル範囲にあるExcel 4.0 のマクロを実行します。
'セル範囲はマクロシートである必要があります｡
'
'構文 1
'
'expression.Run(Macro, Arg1, Arg2, ...)
'
'構文 2
'
'expression.Run(Arg1, Arg2, ...)
'
'
'expression   Application オブジェクトでは省略可能です。
'Range オブジェクトでは必ず指定します｡
'対象となるマクロが含まれるアプリケーション､
'あるいは Excel 4.0 マクロが含まれる
'マクロシートのセル範囲を表すオブジェクト式を指定します｡
'
'Macro   構文 1 では必ず指定します (構文 2 では使用しません)。
'バリアント型 (Variant) の値を使用します。
'実行するマクロを指定します｡
'指定できるのは､マクロ名を示す文字列､
'関数の場所を示す Range オブジェクト、
'DLL や XLL に含まれている関数のレジスタ ID のいずれかです。
'マクロ名を示す文字列を指定すると､アクティブシートの状態に応じて評価されます｡
'
'Arg1, Arg2, ...   省略可能です。
'バリアント型 (Variant) の値を使用します。関数に渡す引数を指定します。
'
'解説
'
'このメソッドの引数では､名前を使用できません｡
'引数には､位置のパスで必ず指定してください｡
'
'Runメソッドは､呼び出したマクロが返す値をそのまま返します｡
'マクロに引数として渡されたオブジェクトは､Value プロパティが適用され､
'値に変換されます｡そのため､Runメソッドを使用する場合は､
'マクロにオブジェクトを引数として渡すことはできません｡

連携 Executeメソッド登録されているプロシージャを実行

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

' コマンドバーコントロールに登録されているプロシージャを実行します。または、ファイルの検索を開始します。
'-------------------------------------------------------------------------------------
'CommandBarButton
'
'Execute メソッド (CommandBarControl オブジェクト)
'
' 指定したコマンドバーコントロールに登録されているプロシージャまたは組み込みのコマンドを実行します。
'カスタムコントロールの場合は、OnAction プロパティを使用して、実行するプロシージャを指定します。
'
'構文
'
'expression.Execute
'
'expression 必ず指定します｡
'CommandBarControl、 CommandBarButton、 CommandBarPopup、 CommandBarComboBox オブジェクトのいずれかを
'表すオブジェクト式を指定します｡
'
'Execute メソッド (CommandBarControl オブジェクト) の使用例
'
'次の Excel での使用例は、コマンドバーを作成し、
'コマンドバーにオート SUM 機能を実行する組み込みのコマンドバーボタンコントロールを追加します。
'次に､コマンドバーを表示し､選択したセル範囲を合計します｡

Dim cbrCustBar As CommandBar
Dim ctlAutoSum As CommandBarButton
Set cbrCustBar = CommandBars.Add("ユーザー設定")
Set ctlAutoSum = cbrCustBar.Controls _
.Add(msoControlButton, CommandBars("Standard").Controls("AutoSum").ID)
cbrCustBar.Visible = True
ctlAutoSum.Execute
'-------------------------------------------------------------------------------------
'CommandBarControl

'Execute メソッド (CommandBarControl オブジェクト)
'
'指定したコマンドバーコントロールに登録されているプロシージャまたは組み込みのコマンドを実行します。
'カスタムコントロールの場合は、OnAction プロパティを使用して、実行するプロシージャを指定します。
'
'構文
'
'expression.Execute
'
'expression 必ず指定します｡
' CommandBarControl、 CommandBarButton、 CommandBarPopup、 CommandBarComboBox オブジェクトのいずれかを
'表すオブジェクト式を指定します｡
'
'Execute メソッド (CommandBarControl オブジェクト) の使用例
'次の Excel での使用例は、コマンドバーを作成し、
'コマンドバーにオート SUM 機能を実行する組み込みのコマンドバーボタンコントロールを追加します。
'次に､コマンドバーを表示し､選択したセル範囲を合計します｡

Dim cbrCustBar As CommandBar
Dim ctlAutoSum As CommandBarButton
Set cbrCustBar = CommandBars.Add("ユーザー設定")
Set ctlAutoSum = cbrCustBar.Controls _
.Add(msoControlButton, CommandBars("Standard").Controls("AutoSum").ID)
cbrCustBar.Visible = True
ctlAutoSum.Execute
'-------------------------------------------------------------------------------------
'CommandBarPopup

'Execute メソッド (CommandBarControl オブジェクト)
'
'指定したコマンドバーコントロールに登録されているプロシージャまたは組み込みのコマンドを実行します。
'カスタムコントロールの場合は、OnAction プロパティを使用して、実行するプロシージャを指定します。
'
'構文
'
'expression.Execute
'
'expression 必ず指定します｡
' CommandBarControl、 CommandBarButton、 CommandBarPopup、 CommandBarComboBox オブジェクトのいずれかを
'表すオブジェクト式を指定します｡
'
'Execute メソッド (CommandBarControl オブジェクト) の使用例
'
'次の Excel での使用例は、コマンドバーを作成し、
'コマンドバーにオート SUM 機能を実行する組み込みのコマンドバーボタンコントロールを追加します。
'次に､コマンドバーを表示し､選択したセル範囲を合計します｡

Dim cbrCustBar As CommandBar
Dim ctlAutoSum As CommandBarButton
Set cbrCustBar = CommandBars.Add("ユーザー設定")
Set ctlAutoSum = cbrCustBar.Controls _
.Add(msoControlButton, CommandBars("Standard") _
.Controls("AutoSum").ID)
cbrCustBar.Visible = True
ctlAutoSum.Execute
'-------------------------------------------------------------------------------------
'CommandBarComboBox

'Execute メソッド (CommandBarControl オブジェクト)
'
'指定したコマンドバーコントロールに登録されているプロシージャまたは組み込みのコマンドを実行します。
'カスタムコントロールの場合は、OnAction プロパティを使用して、実行するプロシージャを指定します。
'
'構文
'
'expression.Execute
'
'expression 必ず指定します｡
'CommandBarControl、 CommandBarButton、 CommandBarPopup、 CommandBarComboBox オブジェクトのいずれかを
'表すオブジェクト式を指定します｡
'
'Execute メソッド (CommandBarControl オブジェクト) の使用例
'
'次の Excel での使用例は、コマンドバーを作成し、
'コマンドバーにオート SUM 機能を実行する組み込みのコマンドバーボタンコントロールを追加します。
'次に､コマンドバーを表示し､選択したセル範囲を合計します｡

Dim cbrCustBar As CommandBar
Dim ctlAutoSum As CommandBarButton
Set cbrCustBar = CommandBars.Add("ユーザー設定")
Set ctlAutoSum = cbrCustBar.Controls _
.Add(msoControlButton, CommandBars("Standard").Controls("AutoSum").ID)
cbrCustBar.Visible = True
ctlAutoSum.Execute

'-------------------------------------------------------------------------------------
'FileSearch

'Execute メソッド (FileSearch オブジェクト)
'
'FileSearch オブジェクトでは､指定したファイルの検索を開始します｡
'
'構文
'
'expression.Execute(SortBy, SortOrder, AlwaysAccurate)
'
'expression 必ず指定します。 FileSearch オブジェクトを表すオブジェクト式を指定します。
'
'SortBy 省略可能です。バリアント型 (Variant) の値を指定します。検索結果のファイルを並べ替えるときの基準を指定します。
'
' 使用できる定数は、 MsoSortBy クラスの msoSortbyFileName (ファイル名)、
'msoSortbyFileType (ファイルの種類)、 msoSortbyLastModified (更新日時)、 msoSortbySize (サイズ) のいずれかです。
'SortOrder 省略可能です。バリアント型 (Variant) の値を指定します。
'検索結果のファイル一覧を並べ替えるときの順序を指定します｡
'
' 使用できる定数は、 MsoSortOrder クラスの msoSortOrderAscending (昇順) または msoSortOrderDescending (降順) です。
'
'AlwaysAccurate 省略可能です。ブール型 (Boolean) の値を指定します。
'True を指定すると、ファイル一覧が最後に更新されてから追加、変更、または削除されたファイルも検索の対象に含まれます。
'既定値は True です。
'
'Execute メソッド (FileSearch オブジェクト) の使用例
'
'次の使用例は、[My Documents] フォルダの中で、ファイル名の拡張子が ".doc" のファイルをすべて検索し、
'条件を満たすファイルの名前と保存場所の一覧を表示します｡また､検索結果のファイル一覧を､ファイル名の昇順で並べ替えます｡

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .Filename = "*.doc"
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            MsgBox .FoundFiles.Count & _
            " 個のファイルが見つかりました。"
                For i = 1 To .FoundFiles.Count
                    MsgBox .FoundFiles(i)
                Next i
        Else
            MsgBox "検索条件を満たすファイルはありません。"
        End If
End With

連携 FTPexeを使いタスク登録し自動時刻に実行

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FTPAutoTimeTaskRegist(CDpath As String, LCDpath As String)
'***************************************
'FTPexeを使いタスク登録し自動時刻に実行
'***************************************
'CDpath     UPするサーバアドレス                    例[www/test/]
'LCDpath    UPされるファイルがあるローカルアドレス  例[C:\Temp\アップ]

'FTPautoTaskRegist-FTPexeを使いタスク登録し指定時刻に実行を改良
'タスクの同時刻実行を回避するため基本開始時刻を設定し定間隔で実行
'コマンドファイルをカウントし一定間隔(分)毎に実行
'※batファイルによりタスク実行後は該当コマンドファイルは削除される
'※によりコマンドファイルは蓄積される事は無い
'パラメータで指定するstrFilePathのパスには関係の無い.txtは置かない事
'※パラメータで指定する基本開始時刻strTimeの初回実行時刻は+Interval
'※よってIntervalが20の場合
'"20:00"に１回目を実行させたい場合はstrTimeを"19:40"にする必要がある

Dim strFilePath As String
Dim strFileName As String
Dim CommandFileName As String
Dim BatFileName As String
Dim ServerName As String
Dim UserID As String
Dim UserPassword As String
Dim strMode As String 'ascii / binary or asc / bin アスキー / バイナリ
Dim Extension As String
Dim FileNO As Integer 'ファイル番号
Dim CommandFileFullPath As String
Dim BatFileFullPath As String
Dim strTime As String
Dim Interval As Long '定間隔

'---------------------------------------------------------------------
'パラメータ(お好み環境に変更してください)
strFilePath = "C:\Temp"         'コマンドファイルの場所(.txt数をカウント)
ServerName = "jp-ia.com"        'UPサーバ名
UserID = "xxxx"                 'ユーザーID
UserPassword = "zzzzzz"         'パスワード
strMode = "ascii"               'モード
Extension = "htm"               'UP対象ファイルの拡張子
strTime = "20:00"               '基本開始時刻例[20:00](小文字必須)
Interval = 20                   '次のタスクを行う間隔(分)
'---------------------------------------------------------------------
'コマンドファイル作成 ①

'ファイル名作成
strFileName = Format(Date, "yyyymmdd") & "_" & Format(time, "hhnnss")
'コマンドファイル名
CommandFileName = strFileName & ".txt"

CommandFileFullPath = strFilePath & "\" & CommandFileName 'フルパス定義
FileNO = FreeFile 'ファイルID取得

Open CommandFileFullPath For Output As #FileNO '新規作成

Print #FileNO, "open " & ServerName
Print #FileNO, "user " & UserID & " " & UserPassword
Print #FileNO, "hash"
Print #FileNO, strMode
Print #FileNO, "cd " & CDpath
Print #FileNO, "lcd " & LCDpath
Print #FileNO, "mput *." & Extension
Print #FileNO, "Quit"

Close #FileNO 'ファイルを閉じる
'---------------------------------------------------------------------
'実行バッチファイルの作成 ②

'バッチファイル名
BatFileName = strFileName & ".bat"
BatFileFullPath = strFilePath & "\" & BatFileName 'フルパス定義
FileNO = FreeFile 'ファイルID取得
Open BatFileFullPath For Output As #FileNO '新規作成

'実行コマンドファイルの変数定義
Print #FileNO, "set cmdTxtPath=" & CommandFileFullPath
'ログファイル生成場所の変数定義
Print #FileNO, "set cmdLogPath=" & strFilePath & "\ftplog"
'日付を取得及び変数定義
Print #FileNO, "set cmdDateA=%date%"
'必要箇所文字を取り出し結合
Print #FileNO, "set cmdDateB=%cmdDateA:~0,4%%cmdDateA:~-5,2%%cmdDateA:~-2,2%"
'時刻を取得及び変数定義
'空白を0に置き換え格納
Print #FileNO, "set cmdTimeA=%time: =0%"
'必要箇所文字を取り出し結合
Print #FileNO, "set cmdTimeB=%cmdTimeA:~0,2%%cmdTimeA:~3,2%%cmdTimeA:~6,2%"
'ログを保存するフォルダ作成
Print #FileNO, "mkdir " & """%cmdLogPath%\"""
'コマンドファイル実行及び④ログファイルの生成
Print #FileNO, "ftp -vni -s:%cmdTxtPath%>%cmdLogPath%\%cmdDateB%_%cmdTimeB%.txt"
'実行コマンドファイルの削除①
Print #FileNO, "del %cmdTxtPath%"

Close #FileNO 'ファイルを閉じる
'---------------------------------------------------------------------
'作成した実行バッチファイルをタスクに登録 ③

'.txt数をカウント   ③-1
Dim buf As String, i As Long
Dim FindExtension As String
Dim CountFiles As Long

FindExtension = "txt"   'カウントする拡張子
i = 0                   '一応
buf = Dir(strFilePath & "\*." & FindExtension)
Do While buf <> ""
    i = i + 1
    buf = Dir()
Loop

CountFiles = i          '合致した該当拡張子のファイル数

'タスク実行時間設定 ③-2
'エラー回避の為の時間形式変換(念のため)
strTime = Format(TimeValue(strTime), "h:mm")
'タスク実行時間を既存の.txt数で設定
    'CountFilesは①で作成される為、最低1つは存在する
    'そのため、初回実行時刻はstrTime+Intervalになる
    '例えばstrTimeを"20:00"に設定し
    'Intervalを20と設定した場合
    '初回実行時間は"20:20"になる
    '[-1]で処理も出来るが何らかのエラー発生事態を考え回避した

strTime = Format(DateAdd("n", Interval * CountFiles, strTime), "h:mm")

'タスクに登録       ③-3
Dim cmd(6) As String
Dim RetVal As Variant
Dim batPath As String

batPath = "" & BatFileFullPath & ""
cmd(1) = "at "
cmd(2) = strTime
cmd(3) = " /"
cmd(4) = "interactive "
cmd(5) = ""                         'オプション[本日１回だけ実行]

'コマンド及び実行バッチパス
cmd(6) = cmd(1) & cmd(2) & cmd(3) & cmd(4) & cmd(5) & batPath

'タスクID取得及びタスクスケジューラに登録
RetVal = Shell(cmd(6), 6)

If RetVal <> 0 Then
    MsgBox batPath & vbCr & "本日" & strTime & "実行のタスク登録が登録されました。" _
    & vbCr & CommandFileFullPath & vbCr & "タスク" & vbCr & _
    "は自動的にタスク実行後に削除されます。", vbInformation, "[タスクID]" & RetVal
Else
    MsgBox batPath & vbCr & "タスク登録は実行出来ません。", vbCritical, "[ERROR]"
End If

End Sub

Private Sub Test()
FTPAutoTimeTaskRegist "www/test/", "C:\Temp\アップ"
End Sub

Mstask.exe(タスクスケジューラ)

同一時刻に実行されるよう設定された 2 つのタスクが存在すると問題が発生することがあります。最初のタスクが正しく発行されると、[タスクを実行中] と表示されます。このとき次のタスクが実行されないと、最初のタスクの後処理が完了しないままとなります。タスクの状態が [タスクを実行中] と表示されているため、以後 Mstask.exe がタスクを実行しようとし続けても実行されません。

変数変数宣言の基本(ヘルプ参照)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub 変数宣言()
'********************************
'変数宣言の基本(ヘルプ参照)
'********************************

'最上部の[Option Explicit]を宣言した場合は必ず[Dim]宣言が必要
'[Option Explicit]を宣言しない場合はバリアント型 (Variant)

' 宣言しない場合、既定のバリアント型 (Variant)
Dim AnyValue, MyValue

' 整数型 (Integer)
Dim Number As Integer

' 変数 AnotherVar はバリアント型
Dim AnotherVar, Choice As Boolean, BirthDate As Date

' 変数 DayArray は、要素数 51 のバリアント型配列
' 添字の範囲は、0 ～ 50 になります。
Dim DayArray(50)

' 変数 Matrix は、整数型の 2 次元配列
Dim Matrix(3, 4) As Integer

' MyMatrix は、倍精度浮動小数点数型 (Double) の 3 次元配列
Dim MyMatrix(1 To 5, 4 To 9, 3 To 5) As Double

' BirthDay は、添字が 1 ～ 10 の範囲の日付型 (Date) の配列
Dim BirthDay(1 To 10) As Date

' MyArray は、バリアント型の動的配列です。
Dim MyArray()

Dim MyArray() As Integer        ' 動的配列を宣言
ReDim MyArray(5)                ' 5 要素分の領域を割り当て
For i = 1 To 5                  ' 5 回、ループ
    MyArray(i) = i              ' 配列を初期化
Next i

'配列のサイズを変更して､以前の要素を消去
ReDim MyArray(10)               ' 配列の要素数を 10 に変更
For i = 1 To 10                 ' 10 回、ループ
    MyArray(i) = i              ' 配列を初期化
Next i

'以前の要素を消去せずに､配列のサイズを変更
ReDim Preserve MyArray(15)      ' 配列の要素数を 15 に変更

End Sub

変数変数の型を取得する(エラーチェック関数)一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub TypeNameFunction()
'***************************
'変数の型を取得する
'***************************

Dim vrnTest(6) As Variant, i As Byte

vrnTest(1) = 123456
vrnTest(2) = 12.34
vrnTest(3) = "ABCD"
vrnTest(4) = CDate("2009/01/01 12:12:12")
vrnTest(5) = 1
vrnTest(6) = True

For i = 1 To 6
    Debug.Print TypeName(vrnTest(i))
Next i

'vrnTest(1)=Long
'vrnTest(2)=Double
'vrnTest(3)=String
'vrnTest(4)=Date
'vrnTest(5)=Integer
'vrnTest(6)=Boolean

'TypeName 関数によって次のいずれかの文字列が返されます｡
'---------------------------------------------------------
'文字列     変数
'---------------------------------------------------------
'Byte       バイト型 (Byte)
'Integer    整数型 (Integer)
'Long       長整数型 (Long)
'Single     単精度浮動小数点数型 (Single)
'Double     倍精度浮動小数点数型 (Double)
'Currency   通貨型 (Currency)
'Decimal    10 進数型
'Date       日付型(Date)
'String     文字列型 (String)
'Boolean    ブール型 (Boolean)
'Error      エラー値
'Empty      未初期化
'Null       無効な値
'Object     オブジェクト
'Unknown    オブジェクトの種類が不明なオブジェクト
'Nothing    オブジェクトを参照していないオブジェクト変数

End Sub

VarType 関数変数の内部処理形式を表す整数型 (Integer) の値を返します。
定数	値	内容
vbEmpty	0	Empty 値 (未初期化)
vbNull	1	Null 値 (無効な値)
vbInteger	2	整数型 (Integer)
vbLong	3	長整数型 (Long)
vbSingle	4	単精度浮動小数点数型 (Single)
vbDouble	5	倍精度浮動小数点数型 (Double)
vbCurrency	6	通貨型 (Currency)
vbDate	7	日付型 (Date)
vbString	8	文字列型 (String)
vbObject	9	オブジェクト
vbError	10	エラー値
vbBoolean	11	ブール型 (Boolean)
vbVariant	12	バリアント型 (Variant) (バリアント型配列にのみ使用)
vbDataObject	13	非OLE オートメーションオブジェクト
vbDecimal	14	10 進数型
vbByte	17	バイト型 (Byte)
vbUserDefinedType	36	ユーザー定義型を含むバリアント型
vbArray	8192	配列
メモこれらの定数は、Visual Basic で定義されているものです。コードの中の任意の場所で、実際の値の代わりに使用できます。解説 VarType 関数は、定数 vbArray の値 (8192) を単独では返しません。この値は常にデータ型を表す他の値と加算されて返され、指定した変数がそのデータ型の要素を持つ配列であることを示します。定数 vbVariant は、常に定数 vbArray と加算されて返され、指定した変数がバリアント型の配列であることを示します。たとえば、整数型の要素を持つ配列を指定したときは、vbInteger + vbArray として計算された値 8194 が返されます。オブジェクトが既定プロパティを持つとき、VarType (object) はその既定プロパティの型を返します。

その他のチェック関数
IsArray 関数	変数が配列であるかどうかを調べ、結果をブール型 (Boolean) で返します。
IsDate 関数	式を日付に変換できるかどうかを調べ、結果をブール型 (Boolean) で返します。
IsEmpty 関数	変数が Empty 値かどうかを調べ、結果をブール型 (Boolean) で返します。
IsMissing 関数	プロシージャに省略可能なバリアント型 (Variant) の引数が渡されたかどうかを調べ、結果をブール型 (Boolean) で返します。
IsError 関数	式がエラー値かどうかを調べ、結果をブール型 (Boolean) で返します。
IsNull 関数	式に Null 値が含まれているかどうかを調べ、結果をブール型 (Boolean) で返します。
IsNumeric 関数	式が数値として評価できるかどうかを調べ、結果をブール型 (Boolean) で返します。
IsObject 関数	識別子がオブジェクト変数を表しているかどうかを示すブール型 (Boolean) の値を返します。

連携 Declareステートメント外部プロシージャへの参照を宣言

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'**********************************
'Declare ステートメントの使用例
'**********************************
'Declare ステートメントを標準モジュールのモジュールレベルにて使用。
'DLLに納められている外部プロシージャへの参照を宣言。
'Declare ステートメントがPrivate であれば、Declare ステートメントをクラスモジュールに記述できます。

'16ビット版 Microsoft Windows の場合
Declare Sub MessageBeep Lib "User" (ByVal N As Integer)

'SomeBeep をプロシージャ名に対するエイリアスと見なします。
Declare Sub MessageBeep Lib "User" Alias "SomeBeep" (ByVal N As Integer)

'Alias 句で序数を使って、GetWinFlags を呼び出します。
Declare Function GetWinFlags Lib "Kernel" Alias "#132" () As Long

'32ビット版 Microsoft Windows ではUSER32.DLL ライブラリを指定
'16ビット版 Microsoft Windows ではUSER.DLL ライブラリを指定
'16ビット版または32ビット版Windowsのいずれかで実行できるコードを記述。
#If Win32 Then
Declare Sub MessageBeep Lib "User32" (ByVal N As Long)
#Else
Declare Sub MessageBeep Lib "User" (ByVal N As Integer)
#End If

Declare ステートメント（ヘルプ抜粋）
ダイナミックリンクライブラリ (DLL) の外部プロシージャへの参照を宣言。モジュールレベルで使用。
構文 1
[Public \| Private] Declare Sub name Lib "libname" [Alias "aliasname"] [([arglist])]
構文 2
[Public \| Private] Declare Function name Lib "libname" [Alias "aliasname"] [([arglist])] [As type]
Declare ステートメントの構文
指定項目	省略	内容
Public	省略可	モジュール内のすべてのプロシージャから参照できるプロシージャを宣言するときに指定します
Private	省略可	宣言が行われたモジュール内でのみ参照できるプロシージャを宣言するときに指定します
Sub	省略可	ただし、Sub を省略する場合には、Function を指定する必要がありますプロシージャが値を返さないことを示します
Function	省略可	ただし、Function を省略する場合には、Sub を指定する必要がありますプロシージャが値を返し、式の中で使えることを示します
name	必須	任意の有効なプロシージャ名を指定します DLL のエントリポイントは大文字小文字を区別して指定することに注意してください
Lib	必須	宣言するプロシージャが DLL またはコードリソースに含まれていることを示します Lib 節は、すべての宣言で必要です
libname	必須	宣言するプロシージャが含まれている DLL またはコードリソースの名前を指定します
Alias	省略可	呼び出すプロシージャが、DLL の中で別の名前を持っていることを示します外部プロシージャの名前が Visual Basic のキーワードと同じ場合に役に立ちます DLL プロシージャの名前が、パブリック変数、パブリック定数、または適用範囲内のほかのプロシージャの名前と同じ場合でも、Alias を使えますまた、Alias は、DLL の名前付け規則に合っていない文字が DLL プロシージャ名に含まれている場合にも使えます
aliasname	省略可	DLL またはコードリソース内のプロシージャの名前を指定します先頭の文字がシャープ記号 (#) でない場合、引数 aliasname には DLL 内で定義されているプロシージャのエントリポイント名を指定します先頭の文字がシャープ記号 (#) の場合は、2 文字目以降の文字にはプロシージャのエントリポイントの序数を指定します
arglist	省略可	プロシージャを呼び出すときに、プロシージャに渡す引数を表す変数のリストを指定します
type	省略可	Function プロシージャの戻り値のデータ型を指定しますバイト型 (Byte)、ブール型 (Boolean)、整数型 (Integer)、長整数型 (Long)、通貨型 (Currency)、単精度浮動小数点数型 (Single)、倍精度浮動小数点数 (Double)、10 進型 (Decimal) (現在はサポートされていません)、日付型 (Date)、文字列型 (String) (可変長のみ)、バリアント型 (Variant)、ユーザー定義型、オブジェクト型のいずれかを指定できます
引数 arglist
[Optional] [ByVal \| ByRef] [ParamArray] varname[( )] [As type]
指定項目	省略	内容
Optional	省略可	指定した引数が省略可能であることを示しますこれを指定した場合は、引数 arglist 内のこれ以降の引数も省略可能でなければならず、すべてキーワード Optional を付けて宣言する必要がありますキーワード ParamArray を使う場合は、どの引数に対してもキーワード Optional は指定できません
ByVal	省略可	その引数が、値渡しで渡されることを示します
ByRef	-	その引数が、参照渡しで渡されることを示します Visual Basic では、既定値はキーワード ByRef です
ParamArray	省略可	引数 arglist の最後に指定する引数としてのみ指定でき、その引数がバリアント型の要素を持つ省略可能 (Optional) な配列であることを示しますキーワード ParamArray を使うと、任意の数の引数を渡すことができますキーワード ParamArray は、ByVal、ByRef、Optional の各キーワードと共に使うことはできません
varname	必須	プロシージャに渡す引数を表す変数の名前を指定します変数の標準的な名前付け規則に従って指定します
( )	条件	配列変数に対しては、必ず指定します引数 varname が配列であることを示します
type	省略可	プロシージャに渡す要素のデータ型を指定しますバイト型 (Byte)、ブール型 (Boolean)、整数型 (Integer)、長整数型 (Long)、通貨型 (Currency)、単精度浮動小数点数型 (Single)、倍精度浮動小数点数型 (Double)、10 進型 (Decimal) (現在はサポートされていません)、日付型 (Date)、文字列型 (String) (可変長のみ)、オブジェクト型 (Object)、バリアント型 (Variant)、ユーザー定義型、オブジェクト型のいずれかを指定できます
解説
Function プロシージャでは、プロシージャのデータ型が戻り値のデータ型になります。関数の戻り値のデータ型は、引数 arglist の後の As 節で指定します。引数 arglist 内では、As 節を使ってプロシージャに渡す引数のデータ型を指定できます。さらに、引数 arglist 内では、標準のデータ型以外に As Any も指定できます。Any を指定すると、データ型のチェックを抑止し、任意のデータ型をプロシージャに渡せます。
空のかっこは、Sub プロシージャまたは Function プロシージャに引数がないことを示し、プロシージャには何も渡されません。次の例では、Sub プロシージャ First には引数がありません。引数を指定して First を呼び出すと、エラーが発生します。
Declare Sub First Lib "MyLib" ()
引数リストを指定すると、プロシージャが呼び出されるたびに引数の個数とデータ型がチェックされます。次の例では、Sub プロシージャ First は長整数型 (Long) の引数を 1 つ受け取ります。
Declare Sub First Lib "MyLib" (X As Long)
メモ
Declare ステートメントの引数リストに固定長文字列を指定することはできません。プロシージャに渡せるのは可変長文字列だけです。プロシージャの引数として固定長文字列を指定すること自体は可能ですが、その固定長文字列は、プロシージャに渡される前に可変長文字列に変換されます。値が 0 の文字列を必要とする外部プロシージャを呼び出す場合は、定数 vbNullString を使います。値が 0 の文字列は、長さ 0 の文字列 (") とは異なります。

Declare ステートメントの使用例

次の例は、Declare ステートメントを標準モジュールのモジュールレベルで使って、ダイナミックリンクライブラリ (DLL) に納められている外部プロシージャへの参照を宣言する方法を示しています。Declare ステートメントがプライベート (Private) であれば、Declare ステートメントをクラスモジュールに記述できます。

16 ビット版 Microsoft Windows の場合

Declare Sub MessageBeep Lib "User" (ByVal N As Integer)
' SomeBeep をプロシージャ名に対するエイリアスと見なします。

Declare Sub MessageBeep Lib "User" Alias "SomeBeep" (ByVal N As Integer)
' Alias 句で序数を使って、GetWinFlags を呼び出します。
Declare Function GetWinFlags Lib "Kernel" Alias "#132" () As Long

32 ビット版 Microsoft Windowsの場合

' 32 ビット版 Microsoft Windows では、USER.DLL ライブラリではなく、
' USER32.DLL ライブラリを指定します。条件付きコンパイルを使えば、
' 16 ビット版または 32 ビット版 Windows のいずれかで実行できるコードを、
' 記述できます。
#If Win32 Then
Declare Sub MessageBeep Lib "User32" (ByVal N As Long)
#Else
Declare Sub MessageBeep Lib "User" (ByVal N As Integer)
#End If

連携コマンドプロンプトCMDexeコマンド送信

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub CMDexeSend()
'*************************************
'コマンドプロンプトCMDexeコマンド送信
'*************************************

Dim strCommand As String
Dim strPath As String

strCommand = "VER" 'Windowsのバージョン取得コマンド

'基本

'終了後コマンドプロンプトCMDexeを閉じる
'Call Shell("Command.com /c " & strCommand) 'Win9X
'Call Shell("CMD.exe /c " & strCommand)     'WinNT
'Call Shell("CMD /c " & strCommand)         'WinNT

'終了もコマンドプロンプトCMDexeを閉じない
'Call Shell("Command.com /k " & strCommand) 'Win9X
'Call Shell("CMD.exe /k " & strCommand)     'WinNT
'Call Shell("CMD /k " & strCommand)         'WinNT

'【Environ関数】
'   オペレーティングシステムの環境変数に割り当てられた文字列型を返します
'【環境変数】
'ComSpecから取得

'Call Shell(Environ$("ComSpec") & " /c " & strCommand) 'Win9X & WinNT
'Call Shell(Environ$("ComSpec") & " /k " & strCommand) 'Win9X & WinNT

'引数にてウィンドを制御
'Call Shell(Environ$("ComSpec") & " /k " & strCommand, vbNormalFocus)

strCommand = "dir"
strPath = "c:\temp"
'Call Shell(Environ$("ComSpec") & " /k " & strCommand & " " & strPath, vbNormalFocus)
'※上記のように" "半角空白はコマンドプロンプトにとって大きな意味を持ちます
'例えば
strPath = "c:\Documents and Settings\XXX"
'の場合
'Call Shell(Environ$("ComSpec") & " /k " & strCommand & " " & strPath, vbNormalFocus)
'ではエラーになります(CMD.exeは実行されます)

strPath = Chr$(34) & "c:\Documents and Settings\XXX" & Chr$(34)
'又は
strPath = """c:\Documents and Settings\XXX"""
'又は
strPath = Chr$(34) & strPath & Chr$(34)
'で回避できます

Call Shell(Environ$("ComSpec") & " /k " & strCommand & " " & strPath, vbNormalFocus)

End Sub

連携 Shell関数で実行したアプリ(タスク)の終了を認識する関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

ここでは２つの方法を紹介しています。

Option Explicit

'①Win32 API関数を使い終了を認識する
Public Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessID As Long) As Long
Public Const PROCESS_QUERY_INFORMATION = &H400

Function TaskQuitForAPI(strTaskPath As String) As Boolean
'******************************************************
'Shell関数で実行したアプリ(タスク)の終了を認識する関数
'******************************************************
'上記Win32 API 関数を使用
'本関数内でShellを実行している為、返値は何でも良いがBooleanを使用

Dim dwProcessID As Long
Dim hProcess As Long
Dim lpdwExitCode As Long
Dim ret As Long

'実行及びタスクIDを取得
dwProcessID = Shell(strTaskPath, 1)
'ハンドル取得
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, True, dwProcessID)

Do
  'プロセスの終了ステータスを取得
  ret = GetExitCodeProcess(hProcess, lpdwExitCode)
  '終了するまで待機
  DoEvents
Loop While lpdwExitCode
'++++++++++++++++++++++++++++++
'ここまで来るとLoopを抜けたので
'++++++++++++++++++++++++++++++
    TaskQuitForAPI = True '返値を返す
End Function

Private Sub test()
Dim strPath As String
'メモ帳のパス
strPath = """C:\WINDOWS\NOTEPAD.EXE"""

If TaskQuitForAPI(strPath) = True Then
MsgBox "タスク" & vbCr & strPath & vbCr & "終了しました。"
End If

End Sub

Option Explicit

'②WScript.Shell(Windows Scripting Host)Runメソッドを使い終了を認識する

Function TaskQuitForWSH(strTaskPath As String) As Boolean
'******************************************************
'Shell関数で実行したアプリ(タスク)の終了を認識する関数
'******************************************************
'WScript.Shell(Windows Scripting Host)Runメソッドを使用
'本関数内でShellを実行している為、返値は何でも良いがBooleanを使用

'Runメソッドの引数
'WaitOnReturn=True-プロセス完了まで待機
CreateObject("WScript.Shell").Run strTaskPath, , True

TaskQuitForWSH = True

End Function

Private Sub test2()
Dim strPath As String
'メモ帳のパス
strPath = """C:\WINDOWS\NOTEPAD.EXE"""

If TaskQuitForWSH(strPath) = True Then
MsgBox "タスク" & vbCr & strPath & vbCr & "終了しました。"
End If

End Sub

連携 VB/VBAからShell関数を使い.bat/.vbs/.jsを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'**************************************************
'VB/VBAからShell関数を使い.bat/.vbs/.jsを実行する
'**************************************************

Sub Shellbat()
'**************************************************
'VB/VBAからShell関数を使い.batを実行する
'**************************************************
'注意①～⑥必須
Dim strPath As String
Dim RetVal As Variant

'Shellにパスやアプリケーション名を渡す時には注意！
'-------------------------------------------------
'注意①パスや名前に空白が無い場合は問題ありません
strPath = "C:\Temp\ftptest.bat"
'注意②このような空白があるパスだとエラーになります
strPath = "C:\Documents and Settings\test\デスクトップ\test\ftptest.bat"
'注意③このように取得するパスでもエラーになります
strPath = ThisWorkbook.Path & "\ftptest.bat"
'注意④回避するには["""]～["""]で囲みます
strPath = """C:\Documents and Settings\test\デスクトップ\test\ftptest.bat"""

'タスクID取得及び実行
RetVal = Shell(strPath, 6) 'vbMinimizedNoFocus

If RetVal <> 0 Then
MsgBox strPath & vbCr & "実行されました。", vbInformation, "[タスクID]" & RetVal
Else
MsgBox strPath & vbCr & "実行出来ません。", vbCritical, "[ERROR]"
End If

'注意⑤実行は確認出来ますが終了は確認出来ません。
'注意⑥終了を確認するにはAPI関数やWSHを使用する方法しかありません。
End Sub

Sub Shellvbs()
'**************************************************
'VB/VBAからShell関数を使い.vbsを実行する
'**************************************************
'上記注意①～⑥必須
Dim strPath As String
Dim RetVal As Variant

strPath = "C:\Temp\test.vbs"

RetVal = Shell("WScript.exe """ & strPath & """")

If RetVal <> 0 Then
MsgBox strPath & vbCr & "実行されました。", vbInformation, "[タスクID]" & RetVal
Else
MsgBox strPath & vbCr & "実行出来ません。", vbCritical, "[ERROR]"
End If

End Sub

Sub Shelljs()
'**************************************************
'VB/VBAからShell関数を使い.jsを実行する
'**************************************************
'上記注意①～⑥必須
Dim strPath As String
Dim RetVal As Variant

strPath = "C:\Temp\test.js"
RetVal = Shell("WScript.exe """ & strPath & """")

If RetVal <> 0 Then
    MsgBox strPath & vbCr & "実行されました。", vbInformation, "[タスクID]" & RetVal
Else
    MsgBox strPath & vbCr & "実行出来ません。", vbCritical, "[ERROR]"
End If

End Sub

'Shell関数(Help抜粋)
'----------------------------------------------------------------
'----------------------------------------------------------------
'プログラムを実行し実行が完了するとプログラムの[タスクID]の値を返す。
'プログラムの実行に問題が発生した場合は[0]を返します。

'構文
'----------------------------------------------------------------
'Shell(pathname[,windowstyle])
'指定項目       省略    内容
'pathname       省略不  実行プログラム名及び
'                       引数名(コマンドラインスイッチ・フォルダ・ドライブ)
'windowstyle    省略可  実行するプログラムのウィンドウの形式値指定(※1)
'                       windowstyleを省略するとフォーカスを持った状態で最小化実行

'(※1)引数[windowstyle]
'----------------------------------------------------------------
'定数               値  フォーカス  内容
'vbHide             0   Focus       非表示
'vbNormalFocus      1   Focus       元のサイズと位置に復元
'vbMinimizedFocus   2   Focus       最小化表示
'vbMaximizedFocus   3   Focus       最大化表示
'vbNormalNoFocus    4   NoFocus     復元
'vbMinimizedNoFocus 6   NoFocus     最小化表示

'注意
'----------------------------------------------------------------
'既定の設定では、Shell 関数はプログラムを非同期的に実行します。
'Shell関数を使用して実行を開始したプログラムが終了しなくても、
'Shell関数の次のステートメントは実行されます。つまり別行動です。

連携リダイレクトを使わず直接コマンドの実行結果を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function CMDcommandResultGet(strCommand As String) As String
'********************************************************
'リダイレクトを使わず直接コマンドの実行結果を取得する①
'********************************************************
'Windows Scripting Host(WSH)-WshShell-Execメソッド
'Functionで全ての値を取得(StdOut/stderr)
Dim WshShell As Object
Dim oExec As Object

Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("%ComSpec% /c " & strCommand) 'Exec メソッド

If Not oExec.StdOut.AtEndOfStream Then 'StdOut プロパティ'AtEndOfStream プロパティ
     CMDcommandResultGet = oExec.StdOut.ReadAll 'ReadAll メソッド
     Exit Function
End If

If Not oExec.stderr.AtEndOfStream Then 'stderr プロパティ'AtEndOfStream プロパティ
     CMDcommandResultGet = oExec.stderr.ReadAll 'ReadAll メソッド
     Exit Function
End If

End Function

Sub CommandResultGet(ByVal strCommand As String, ByRef blnERR As Boolean, _
ByRef strRead As String)
'********************************************************
'リダイレクトを使わず直接コマンドの実行結果を取得する②
'********************************************************
'Windows Scripting Host(WSH)-WshShell-Execメソッド
'Call-Subでエラー値も取得(StdOut/stderr)

'strCommandはコマンド引数
'blnERRはエラー値で無い場合FALSEを返す
'strReadは値を返す

Dim WshShell As Object
Dim oExec As Object

Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("%ComSpec% /c " & strCommand) 'Exec メソッド

If Not oExec.StdOut.AtEndOfStream Then 'StdOut プロパティ'AtEndOfStream プロパティ
     strRead = oExec.StdOut.ReadAll 'ReadAll メソッド
     blnERR = False '返値
     Exit Sub
End If

If Not oExec.stderr.AtEndOfStream Then 'stderr プロパティ'AtEndOfStream プロパティ
     strRead = oExec.stderr.ReadAll 'ReadAll メソッド
     blnERR = True '返値
     Exit Sub
End If

End Sub

Private Sub test1() '①
Dim strCommand As String

strCommand = "ver"

MsgBox CMDcommandResultGet(strCommand)
Debug.Print CMDcommandResultGet(strCommand)

End Sub

Private Sub test2() '②

Dim blnERR As Boolean
Dim strRead As String
Dim strCommand As String

strCommand = "ver"

Call CommandResultGet(strCommand, blnERR, strRead)

If blnERR = False Then
MsgBox strRead, vbInformation, "OK"
Else
MsgBox strRead, vbCritical, "ERROR"
End If

Debug.Print strRead

End Sub

Windows Script Host
Exec メソッド
子コマンドシェルでアプリケーションを実行します。アプリケーションから StdIn/StdOut/StdErr ストリームにアクセスできます。

構文
object.Exec(strCommand)
引数
object
- WshShell オブジェクトです。
strCommand
- スクリプトの実行に使用するコマンドラインを示す文字列値です。コマンドプロンプトから入力する場合と全く同じコマンドラインを指定します。
解説
Exec メソッドが返す WshScriptExec オブジェクトを使用すると、Exec メソッドを使って実行したスクリプトのステータス情報やエラー情報だけでなく、StdIn、StdOut、および StdErr チャンネルにもアクセスできます。Exec メソッドで実行できるのは、コマンドラインのアプリケーションのみです。Exec メソッドを使ってリモートのスクリプトを実行することはできません。Exec メソッドを (WshRemote オブジェクトの) Execute メソッドと混同しないように注意してください。

Windows Script Host
StdOut プロパティ (WshScriptExec)
Exec オブジェクトの書き込み専用の stdout 出力ストリームを公開します。

構文
Object.StdOut
引数
Object
- WshScriptExec オブジェクトです。
解説
StdOut プロパティには、スクリプトから標準出力に送信された全情報のコピー (読み取り専用) が格納されます。

Windows Script Host
StdErr プロパティ(WshScriptExec)
Exec オブジェクトの stderr 出力ストリームへのアクセスを提供します。

構文
Object.StdErr
引数
Object
- WshScriptExec オブジェクトです｡
解説
Exec で起動されたプロセスから stderr ストリームに送信されたデータを取得する場合に
StdErr プロパティを使用します｡

Windows Script Host
AtEndOfStream プロパティ
入力ストリームの最後に達したかどうかを示すブール値を返します｡

構文
object.AtEndOfStream
引数
Object
- StdIn テキストストリームオブジェクトです。
解説
AtEndOfStream プロパティには､入力ストリームの最後に達したかどうかを示すブール値が格納されます。AtEndOfStream プロパティは、ストリームポインタが入力ストリームの最後を指している場合は True を返し、それ以外の場合は Falseを返します。StdIn、StdOut、および StdErr のプロパティとメソッドは、スクリプトを CScript.exe で実行した場合にのみ動作します。WScript.exe を使ってスクリプトを実行すると､エラーが発生します｡

Windows Script Host
ReadAll メソッド
入力ストリーム全体を読み込み､結果の文字列を返します｡

構文
object.ReadAll
引数
Object
- StdIn テキストストリームオブジェクトです。
解説
ReadAll は文字列を返します。StdIn プロパティ、StdOut プロパティ、および StdErrプロパティとメソッドは、スクリプトを CScript.exe で実行した場合にのみ動作します。WScript.exe でスクリプトを実行すると、"無効なハンドルです。" というエラーが発生します。

連携コントロールパネルのタスクスケジューラにbatファイルを登録

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ShellATcmd()
'***********************************************************
'コントロールパネルのタスクスケジューラにbatファイルを登録
'***********************************************************
'バッチ.batファイルを登録する
'ATコマンド
'コントロールパネルのタスクスケジューラツール

Dim batPath(2) As String
Dim cmd(6) As String
Dim LogPath As String

Dim RetVal As Variant

'==================================================
'########################
'9：27に実行する
'########################
cmd(1) = "at "
cmd(2) = "9：27" '実行時刻
cmd(3) = " /"
cmd(4) = "interactive "
'実行され不必要になったタスクは自動で削除されます。

cmd(5) = "/next:10 "                'オプション[当日１回だけ実行-次の10日]
cmd(5) = "/next:10,20 "             'オプション[当日１回だけ実行-次の10日と20日]
cmd(5) = "/next:T "                 'オプション[当日１回だけ実行-次の火曜日]
cmd(5) = "/every:15 "               'オプション[当日永久実行-毎月15日]
cmd(5) = "/every:15,25 "            'オプション[当日永久実行-毎月15日と25日]
cmd(5) = "/every:S "                'オプション[当日永久実行-毎週土曜日]
cmd(5) = "/every:M,T,W,Th,F,S,Su "  'オプション[当日永久実行-毎日]
cmd(5) = ""                         'オプション[本日１回だけ実行]
'※日[Su]月[M]火[T]水[W]木[Th]金[F]土[S]
'==================================================

batPath(1) = """C:\Temp\ftptest.bat"""
batPath(2) = """C:\Temp\ftptest1.bat"""

'-----------------------------------------------------------------------
'【batファイルの実行】
'-----------------------------------------------------------------------
'タスクID取得及び実行
RetVal = Shell(batPath(1), 6) 'vbMinimizedNoFocus
'↑タスクID取得　↑実行

If RetVal <> 0 Then
    MsgBox batPath(1) & vbCr & "実行されました。", vbInformation, "[タスクID]" & RetVal
Else
    MsgBox batPath(1) & vbCr & "実行出来ません。", vbCritical, "[ERROR]"
End If

'-----------------------------------------------------------------------
'【batファイルをタスクスケジューラに登録】
'-----------------------------------------------------------------------
'※注意：実行するたびに例え同じ内容でもタスクに登録されます。
'同じ内容の場合は１度限りの実行を行ってください。

'コマンド及び実行バッチパス
cmd(6) = cmd(1) & cmd(2) & cmd(3) & cmd(4) & cmd(5) & batPath(2)

'タスクID取得及びタスクスケジューラに登録
RetVal = Shell(cmd(6), 6)

If RetVal <> 0 Then
    MsgBox batPath(1) & vbCr & "タスク登録が実行されました。", vbInformation, "[タスクID]" & RetVal
Else
    MsgBox batPath(1) & vbCr & "タスク登録は実行出来ません。", vbCritical, "[ERROR]"
End If

End Sub

Mstask.exe(タスクスケジューラ)

同一時刻に実行されるよう設定された 2 つのタスクが存在すると問題が発生することがあります。最初のタスクが正しく発行されると、[タスクを実行中] と表示されます。このとき次のタスクが実行されないと、最初のタスクの後処理が完了しないままとなります。タスクの状態が [タスクを実行中] と表示されているため、以後 Mstask.exe がタスクを実行しようとし続けても実行されません。

登録したタスクを削除する
C:\>at 1 /delete

登録したタスクエントリーを表示する
C:\>at
一覧にエントリが存在しません｡

【AT コマンドの概要】

at コマンドを使用すると、コマンド、スクリプト、またはプログラムを指定した日時に実行するようにスケジュールできます。
このコマンドを使用して、既存のタスクを表示することもできます。
at コマンドを使用するには、タスクスケジューラサービスが動作していて、ローカルの Administrators グループのメンバとしてログオンしている必要があります。
at コマンドを使用してタスクを作成する場合、タスクが同じユーザーアカウントで実行されるように、タスクを設定する必要があります。

【AT コマンド構文】

at \\computername time /interactive \| /every:date,... /next:date,... command
at	\\computername	time	/interactive	\|	/every:date,...	/next:date,...	command
	①	②	③		④	⑤	⑥
at \\computername id /delete \| /delete/yes
at	\\computername	id	/delete	\|	/delete	/yes
		⑦	⑧			⑨

【AT コマンドパラメータ一覧】

①\\computername

リモートコンピュータを指定する場合に使用します。
このパラメータを指定しなければ、タスクはローカルコンピュータ上で実行するようにスケジュールされます。

②time

タスクの実行時刻を指定する場合に使用します。
時刻は、24 時間制に基づき hours:minutes のように指定します。
たとえば、0:00 は真夜中、20:30 は午後 8:30 を表します。

③/interactive

タスクの実行時にログオンしているユーザーのデスクトップとの対話を、タスクに許可する場合に使用します。

④/every:date,...

タスクを指定した日付または曜日 (たとえば、毎週金曜日、毎月 8 日) に実行するようスケジュールする場合に使用します。
date には、1 つ以上の曜日 (省略形 M、T、W、Th、F、S、Su を使用)、または 1 つ以上の日付 (1 ～ 31 の数値を使用) を指定します。
複数の日付を指定する場合は、必ずコンマで区切ります。
このパラメータを指定しなければ、タスクは現在の日付で実行するようにスケジュールされます。

⑤/next:date,...

タスクを次の日付または曜日 (たとえば、次の月曜日) に実行するようスケジュールする場合に使用します。
date には、1 つ以上の曜日 (省略形 M、T、W、Th、F、S、Su を使用)、または 1 つ以上の日付 (1 ～ 31 の数値を使用) を指定します。
複数の日付を指定する場合は、必ずコンマで区切ります。
このパラメータを指定しなければ、タスクは現在の日付で実行するようにスケジュールされます。

⑥command

実行する Windows 2000 コマンド、プログラム (.exe ファイルや .com ファイル)、またはバッチプログラム (.bat ファイルや .cmd ファイル) を指定する場合に使用します。
コマンドで引数としてパスが必要な場合、絶対パス名 (ドライブ文字で始まるパス全体) を使用します。
コマンドがリモートコンピュータ上にある場合は、UNC (Uniform Naming Convention) パス名 (\\ServerName\ShareName) を使用します。
コマンドが実行可能ファイル (.exe) でない場合、たとえば、cmd /c copy C:\*.* C:\temp のように、コマンドの前に cmd /c を挿入します。

⑦id

タスクに割り当てる ID 番号を指定する場合に使用します。

⑧/delete

タスクをキャンセルする場合に使用します。
id パラメータを指定しない場合、コンピュータ上のすべてのタスクがキャンセルされます。

⑨/yes

タスクのキャンセル時にシステムからの問い合わせすべてに yes (はい) と回答する場合に使用します。
このパラメータを指定しなければ、タスクのキャンセルを確認するダイアログボックスが表示されます。

注 : at コマンドを使用すると、システムアカウントの資格情報を使用してタスクが実行されます。

【タスクの作成方法】

[スタート] ボタンをクリックし、[プログラム]、[アクセサリ] を順にポイントし、[コマンドプロンプト] をクリックします。
コマンドプロンプトで次の行を入力し、Enter キーを押して、現在実行中のサービス一覧を表示します。
net start
一覧にタスクスケジューラが表示されていない場合、次の行を入力し、Enter キーを押します。
net start "task scheduler"
コマンドプロンプトで次の行を入力し、Enter キーを押します (状況に応じて適切なパラメータを使用します)。
at \\computername time /interactive | /every:date,... /next:date,... command

例1

夜間にすべてのファイルを Documents フォルダから MyDocs フォルダにコピーするには、次の行を入力し、Enter キーを押します。
at 00:00 cmd /c copy C:\Documents\*.* C:\MyDocs

例2

平日の毎日午後 11:00 に Products サーバーをバックアップするには、バックアップコマンドを含むバッチファイル (Backup.bat など) を作成します。
次に、以下の行を入力し、Enter キーを押して、バックアップをスケジュールします。
at \\products 23:00 /every:M,T,W,Thu,F backup

例3

午前 6:00 に Sales サーバー上で net share コマンドを実行するようにスケジュールし、出力結果を Corp サーバー上の Reports 共有フォルダの Sales.txt ファイルにリダイレクトするには、次の行を入力し、Enter キーを押します。
at \\sales 06:00 cmd /c "net share reports=d:\Documents\reports >> \\corp\reports\sales.txt"

タスクのキャンセル

[スタート] ボタンをクリックし、[プログラム]、[アクセサリ] を順にポイントし、[コマンドプロンプト] をクリックします。
コマンドプロンプトで次の行を入力し、Enter キーを押して、現在実行中のサービス一覧を表示します。
net start
一覧にタスクスケジューラが表示されていない場合、次の行を入力し、Enter キーを押します。
net start "task scheduler"
コマンドプロンプトで次の行を入力し、Enter キーを押します (状況に応じて適切なパラメータを使用します)。
at \\computername id /delete | /delete/yes

例

ローカルコンピュータ上でスケジュールされているタスクをすべてキャンセルするには、at /delete と入力し、Enter キーを押します。
MyServer という名前のコンピュータ上のタスク ID 8 をキャンセルするには、at \\MyServer 8 /delete と入力し、Enter キーを押します。

【タスクの表示方法】

at コマンドを使用して作成したタスクを表示するには、以下の手順を実行します。
[スタート] ボタンをクリックし、[プログラム]、[アクセサリ] を順にポイントし、[コマンドプロンプト] をクリックします。
コマンドプロンプトで次の行を入力し、Enter キーを押して、現在実行中のサービス一覧を表示します。
net start
一覧にタスクスケジューラが表示されていない場合、次の行を入力し、Enter キーを押します。
net start "task scheduler"
コマンドプロンプトで次の手順のいずれかを実行します。
at コマンドを使用してスケジュールしたタスクの一覧を表示するには、次の行を入力し、Enter キーを押します。
at \\computername
または
特定のタスクを表示するには、次の行を入力し、Enter キーを押します。
at \\computername id

例

ローカルコンピュータ上のすべてのタスクを表示するには、at と入力し、Enter キーを押します。
Support という名前のコンピュータ上のタスクをすべて表示するには、at \\support と入力し、Enter キーを押します。
ローカルコンピュータ上のタスク ID 18 を表示するには、at 18 と入力し、Enter キーを押します。

【トラブルシューティング】

at \\computername と入力してタスクの一覧を表示したときに、at コマンドを使用して作成したタスクの一部 (または全部) が表示されません。
- この現象は、at コマンドを使用してタスクを作成した後、[タスク] フォルダ内のタスクを修正した場合に発生することがあります。at コマンドを使用してタスクをスケジュールすると、そのタスクはコントロールパネルの [タスク] フォルダに表示されます。[タスク] フォルダでタスクを表示または修正することはできます。ただし、タスクを修正すると、at コマンドの使用時にタスクを表示できなくなります。
- この現象を回避するには、タスクの表示または修正をコントロールパネルの [タスク] フォルダで行います。
- タスクスケジューラツールで AT タスクを表示できない
at コマンドを使用してタスクをスケジュールしたときに、タスクが指定日時に実行されません。
- この現象は、以下の状況のいずれかに該当する場合に発生することがあります。
- コマンド構文が正しくありません。
- タスクをスケジュールした後、at \\computername と入力し、構文が正しいことを確認します。コマンドラインの下に表示された情報が間違っている場合は、タスクをキャンセルし、再作成します。
- または
- .exe ファイルでないコマンドを実行するようにタスクをスケジュールしています。
- at コマンドは、コマンドの実行前に cmd (コマンドインタプリタ) を自動的に読み込みません。
- .exe ファイルを実行する場合以外では、at cmd /c dir > c:\test.txt のようにコマンドの先頭で Cmd.exe を読み込む必要があります。

ヘルプを表示する
C:\>at /?
又は
C:\>help at
AT コマンドは､指定された日時にコマンドとプログラムがコンピュータで
実行されるようにスケジュールします｡AT コマンドを使用するには､
Schedule サービスが実行中でなければなりません｡

AT [\\コンピュータ名] [ [id] [/DELETE] | /DELETE [/YES]]
AT [\\コンピュータ名] 時刻 [/INTERACTIVE]
   [ /EVERY:日付[,...] | /NEXT:日付[,...]] "コマンド"

\\コンピュータ名     リモートコンピュータを指定します。このパラメータを
                     省略したときは､ローカルコンピュータでコマンドが
                     スケジュールされます｡
id スケジュールされたコマンドに割り当てられた識別番号です｡
/delete              スケジュールされたコマンドを取り消します。
                     id を指定しなかったときは､コンピュータでスケジュール
                     されているすべてのコマンドが取り消されます｡
/yes                 確認せずにすべてのジョブコマンドを取り消すときに
                     使用します｡
時刻コマンドが実行される時刻を指定します｡
/interactive         ジョブの実行中、ジョブはログオンしているユーザーの
                     デスクトップとの対話を許可します｡
/every:日付[,...]    毎週指定した曜日に、または毎月指定した日にコマンドが
                     実行されます｡
                     日付を省略したときは､その月の今日の日付が使用されます｡
/next:日付[,...]     指定したコマンドが次の日付 (たとえば、次の火曜日) に
                     実行されます｡日付を省略したときは､その月の今日の日付が
                     使用されます｡
"コマンド"           実行する Windows NT コマンド、またはバッチプログラム
                     です｡

連携指定サーバにファイルをアップFTPexeを使いタスク登録し指定時刻に実行

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FTPautoTaskRegist(CDpath As String, LCDpath As String, strTime As String)
'***************************************
'FTPexeを使いタスク登録し指定時刻に実行
'***************************************
'CDpath     UPするサーバアドレス                    例[www/test/]
'LCDpath    UPされるファイルがあるローカルアドレス  例[C:\Temp\アップ]
'strTime    UP時刻                                  例[20:00](小文字必須)

Dim strFilePath As String
Dim strFileName As String
Dim CommandFileName As String
Dim BatFileName As String
Dim ServerName As String
Dim UserID As String
Dim UserPassword As String
Dim strMode As String 'ascii / binary or asc / bin アスキー / バイナリ
Dim Extension As String
Dim FileNO As Integer 'ファイル番号
Dim CommandFileFullPath As String
Dim BatFileFullPath As String

'---------------------------------------------------------------------
'パラメータ(お好み環境に変更してください)
strFilePath = "C:\Temp"         'コマンドファイルの場所
ServerName = "jp-ia.com"        'UPサーバ名
UserID = "xxxx"                 'ユーザーID
UserPassword = "zzzzzz"         'パスワード
strMode = "ascii"               'モード
Extension = "htm"               'UP対象ファイルの拡張子

'---------------------------------------------------------------------
'コマンドファイル作成 ①

'ファイル名作成
strFileName = Format(Date, "yyyymmdd") & "_" & Format(time, "hhnnss")
'コマンドファイル名
CommandFileName = strFileName & ".txt"

CommandFileFullPath = strFilePath & "\" & CommandFileName 'フルパス定義
FileNO = FreeFile 'ファイルID取得

Open CommandFileFullPath For Output As #FileNO '新規作成

Print #FileNO, "open " & ServerName
Print #FileNO, "user " & UserID & " " & UserPassword
Print #FileNO, "hash"
Print #FileNO, strMode
Print #FileNO, "cd " & CDpath
Print #FileNO, "lcd " & LCDpath
Print #FileNO, "mput *." & Extension
Print #FileNO, "Quit"

Close #FileNO 'ファイルを閉じる
'---------------------------------------------------------------------
'実行バッチファイルの作成 ②

'バッチファイル名
BatFileName = strFileName & ".bat"
BatFileFullPath = strFilePath & "\" & BatFileName 'フルパス定義
FileNO = FreeFile 'ファイルID取得
Open BatFileFullPath For Output As #FileNO '新規作成

'実行コマンドファイルの変数定義
Print #FileNO, "set cmdTxtPath=" & CommandFileFullPath
'ログファイル生成場所の変数定義
Print #FileNO, "set cmdLogPath=" & strFilePath & "\ftplog"
'日付を取得及び変数定義
Print #FileNO, "set cmdDateA=%date%"
'必要箇所文字を取り出し結合
Print #FileNO, "set cmdDateB=%cmdDateA:~0,4%%cmdDateA:~-5,2%%cmdDateA:~-2,2%"
'時刻を取得及び変数定義
'空白を0に置き換え格納
Print #FileNO, "set cmdTimeA=%time: =0%"
'必要箇所文字を取り出し結合
Print #FileNO, "set cmdTimeB=%cmdTimeA:~0,2%%cmdTimeA:~3,2%%cmdTimeA:~6,2%"
'ログを保存するフォルダ作成
Print #FileNO, "mkdir " & """%cmdLogPath%\"""
'コマンドファイル実行及び④ログファイルの生成
Print #FileNO, "ftp -vni -s:%cmdTxtPath%>%cmdLogPath%\%cmdDateB%_%cmdTimeB%.txt"
'実行コマンドファイルの削除①
Print #FileNO, "del %cmdTxtPath%"

Close #FileNO 'ファイルを閉じる
'---------------------------------------------------------------------
'作成した実行バッチファイルをタスクに登録 ③
Dim cmd(6) As String
Dim RetVal As Variant
Dim batPath As String

batPath = "" & BatFileFullPath & ""
cmd(1) = "at "
cmd(2) = strTime
cmd(3) = " /"
cmd(4) = "interactive "
cmd(5) = ""                         'オプション[本日１回だけ実行]

'コマンド及び実行バッチパス
cmd(6) = cmd(1) & cmd(2) & cmd(3) & cmd(4) & cmd(5) & batPath

'タスクID取得及びタスクスケジューラに登録
RetVal = Shell(cmd(6), 6)

If RetVal <> 0 Then
    MsgBox batPath & vbCr & "本日" & strTime & "実行のタスク登録が登録されました。" _
    & vbCr & CommandFileFullPath & vbCr & "タスク" & vbCr & _
    "は自動的にタスク実行後に削除されます。", vbInformation, "[タスクID]" & RetVal
Else
    MsgBox batPath & vbCr & "タスク登録は実行出来ません。", vbCritical, "[ERROR]"
End If

End Sub

Private Sub Test()
FTPautoTaskRegist "www/test/", "C:\Temp\アップ", "17:59"
End Sub

上記のPrivate Sub Test()を実行すると(実行した日付が2010/01/06の場合)

登録完了メッセージが表示 OK

C:\Temp に
②20100106_175715.bat と
①20100106_175715.txt が
実行された日付時刻形式で作成される

指定された時刻に実行予定の
③タスクがスケジュールされ追加される
ここでは「At1」

タスクが実行された後は
③そのタスクは自動で削除される
（１回だけの実行の場合）

作成したbatファイルによりコマンドファイル
①20100106_175715.txt が削除される
このファイルにはIDやパスワードが記載されている
②20100106_175715.bat は実行後も残る
不要な場合は手動で削除する
このファイルにはIDやパスワードは記載されていない

指定(作成)したC:\Temp\ftplog にはログファイルが実行された日付時刻形式で作成される④
ログを確認後不要な場合は手動で削除する
このファイルにはIDやパスワード及び実行ログが記載されている

①20100106_175715.txt　の中身

open jp-ia.com
user xxxx zzzzzz
hash
ascii
cd www/test/
lcd C:\Temp\アップ
mput *.htm

②20100106_175715.bat　の中身

set cmdTxtPath=C:\Temp\20100106_175715.txt
set cmdLogPath=C:\Temp\ftplog
set cmdDateA=%date%
set cmdDateB=%cmdDateA:~0,4%%cmdDateA:~-5,2%%cmdDateA:~-2,2%
set cmdTimeA=%time: =0%
set cmdTimeB=%cmdTimeA:~0,2%%cmdTimeA:~3,2%%cmdTimeA:~6,2%
MkDir "%cmdLogPath%\"
ftp -vni -s:%cmdTxtPath%>%cmdLogPath%\%cmdDateB%_%cmdTimeB%.txt
del %cmdTxtPath%

C:\Temp\ftplog\20100106_175900.txt ログの中身

ftp> ftp> open jp-ia.com
ftp> user xxxx zzzzzz
Hash mark printing On ftp: (2048 bytes/hash mark) .

ftp> hash
ftp> ascii
ftp> cd www/test/
Local directory now C:\Temp\アップ.

ftp> lcd C:\Temp\アップ
mput *.htm
##########
########
########
##########
ftp> Quit

※##########の部分がハッシュ（実行された時間を#で示したもの)

Mstask.exe(タスクスケジューラ)

同一時刻に実行されるよう設定された 2 つのタスクが存在すると問題が発生することがあります。最初のタスクが正しく発行されると、[タスクを実行中] と表示されます。このとき次のタスクが実行されないと、最初のタスクの後処理が完了しないままとなります。タスクの状態が [タスクを実行中] と表示されているため、以後 Mstask.exe がタスクを実行しようとし続けても実行されません。

制御指定時間経過後又は定刻にプロシージャを実行する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'===============================================
'指定時間経過後又は定刻にプロシージャを実行する
'===============================================

Dim PublicSetTime As Date

Sub OnTimeSample1()
'***********************************************
'現在から～秒後にプロシージャを実行する
'***********************************************

Dim SetTime As Date
SetTime = "00:00:05"
Application.OnTime Now + TimeValue(SetTime), "OnTimeTestSub"

End Sub

Sub OnTimeSample2()
'***********************************************
'～時にプロシージャを実行する
'***********************************************

Dim SetTime As Date
SetTime = "09:30:00"
PublicSetTime = SetTime 'OnTimeSample3用
Application.OnTime TimeValue(SetTime), "OnTimeTestSub"

End Sub

Sub OnTimeSample3()
'***********************************************
'OnTimeメソッドの設定を取り消す
'***********************************************
'OnTimeSample2を取り消す
Application.OnTime EarliestTime:=TimeValue(PublicSetTime), _
Procedure:="OnTimeTestSub", Schedule:=False '※①

End Sub

Sub OnTimeTestSub()
    MsgBox "実行しました！"
End Sub

'OnTime メソッドの使用例(ヘルプ抜粋)
'---------------------------------------------------------------------------------

'OnTimeメソッド
'---------------------------------------------------------------------------------
'指定された時刻 (特定の日時、または特定の期間の経過後) にプロシージャを実行します。

'構文
'---------------------------------------------------------------------------------
'オブ.OnTime(EarliestTime, Procedure, LatestTime, Schedule)
'
'オブ           省略不対象オブジェクト式指定
'EarliestTime   省略不実行時刻指定
'Procedure      省略不実行プロシージャ名指定
'LatestTime     省略可プロシージャを実行できる最終時刻を指定
'Schedule       省略可新しいOnTimeプロシージャを設定
'---------------------------------------------------------------------------------
'補足　LatestTime
'EarliestTimeで設定した値 + 30 を設定します。
'EarliestTimeに指定した時刻には他のプロシージャを実行しているため、
'Excelが待機/コピー/切り取り/検索のいずれのモードでもないとします。
'その場合Excelは実行中のプロシージャが終了するまで30秒間待ちます。
'30秒以内にExcelが待機モードにならないとき指定したプロシージャは実行されません。
'この引数を省略すると、Excel はプロシージャが実行できるまで待ちます。
'---------------------------------------------------------------------------------
'補足　Schedule　※①
'新しいOnTimeプロシージャを設定するには、True を指定
'直前のプロシージャの設定を解除するには、False を指定

制御既に開かれているブックを検索する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub OpenExcelCount()
Dim I, ThisName As String
ThisName = ThisWorkbook.Name
If Workbooks.Count <> 1 Then
MsgBox "既に開かれているブックが " & Workbooks.Count - 1 & " 個あります。" & vbCr & vbCr & "閉じてから実行してください。", vbCritical, ThisName

For Each I In Workbooks
If ThisName <> I.Name Then
MsgBox I.Name & "を閉じてください。", vbCritical, ThisName
End If
Next

End If
End Sub

制御指定した標準モジュールのソースコードを全行削除する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ModuleDelete()
'**************************************************
'指定した標準モジュールのソースコードを全行削除する
'**************************************************

Dim cntLine As Long, strModule As String

strModule = "module3" '該当モジュール名を指定

With ActiveWorkbook.VBProject.VBComponents(strModule).CodeModule

    '該当モジュールのソースライン総数取得
    cntLine = .CountOfLines

    '指定行目から指定行目までを削除
    .DeleteLines 1, cntLine

End With

End Sub

制御プロシージャからAlt+PrintScreenを取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Declare Sub keybd_event Lib "User32" _
(ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Sub GetAltPrintScreen()
'******************************************
'プロシージャからAlt+PrintScreenを取得する
'******************************************
'NT系の場合
'アクティブウィンドウのみ
'参考 http://support.microsoft.com/kb/411704/ja

Call keybd_event(CByte(vbKeyMenu), 0, 0, 0) 'Alt キー
Call keybd_event(CByte(vbKeySnapshot), 0, 0, 0) 'PrintScreen キー
Call keybd_event(CByte(vbKeySnapshot), 0, 2, 0) 'PrintScreen キー
Call keybd_event(CByte(vbKeyMenu), 0, 2, 0) 'Alt キー

'VOID keybd_event(
'  BYTE bVk,               // 仮想キーコード
'  BYTE bScan,             // ハードウェアスキャンコード
'  DWORD dwFlags,          // 関数のオプション
'  ULONG_PTR dwExtraInfo   // 追加のキーストロークデータ
');
End Sub

Sub GetPrintScreen()
'**************************************
'プロシージャからPrintScreenを取得する
'**************************************
'NT系の場合
'画面全体
'参考 http://support.microsoft.com/kb/411704/ja

Call keybd_event(CByte(vbKeySnapshot), 0, 0, 0) 'PrintScreen キー
Call keybd_event(CByte(vbKeySnapshot), 0, 2, 0) 'PrintScreen キー

'VOID keybd_event(
'  BYTE bVk,               // 仮想キーコード
'  BYTE bScan,             // ハードウェアスキャンコード
'  DWORD dwFlags,          // 関数のオプション
'  ULONG_PTR dwExtraInfo   // 追加のキーストロークデータ
');
End Sub

プラットフォーム SDK

keybd_event

キーストロークを合成します。システムは、合成されたキーストロークから、またはメッセージを生成します。キーボードドライバの割り込みハンドラは、この関数を呼び出します。
Windows NT/2000：この関数は、SendInput 関数に取って代わられています。この関数の代わりに SendInput を使ってください。
VOID keybd_event(
BYTE bVk, // 仮想キーコード
BYTE bScan, // ハードウェアスキャンコード
DWORD dwFlags, // 関数のオプション
ULONG_PTR dwExtraInfo // 追加のキーストロークデータ
);
パラメータ
bVk
- ［入力］仮想キーコードを指定します。このコードは、1～254 の範囲内の値でなければなりません。詳細なリストについては、「」を参照してください。
bScan
- このパラメータは未使用です。
dwFlags
- ［入力］関数の動作を指定します。次のフラグを任意に組み合わせて指定します。
- 値意味
  KEYEVENTF_EXTENDEDKEY
  - このフラグをセットすると、スキャンコードにプリフィックスバイト 0xE0（224）を追加します。
  KEYEVENTF_KEYUP
  - このフラグをセットすると、キーを離す操作になります。セットしない場合、キーを押す操作になります。
dwExtraInfo
- ［入力］キーストロークに関連する 32 ビットの追加情報を指定します。
戻り値
- 戻り値はありません。
解説
- アプリケーションは画面のスナップショットを取得してクリップボードに記憶させるために、PrintScreen キーの押し下げをシミュレートすることもできます。このような操作を行うには、bVk パラメータを VK_SNAPSHOT に設定して、keybd_event を呼び出します。
- Windows NT：keybd_event 関数は、NumLock、CapsLock、ScrollLock の各キーをトグルさせる（オンとオフを交互に繰り返す）こともできます。
- Windows 95：keybd_event 関数がトグルさせることができるのは、CapsLock と ScrollLock の各キーだけです。NUM LOCK キーをトグルさせることはできません。

制御ブックOpen時にModuleを読み込みClose時にModuleを削除

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

改変しました。

①ブックOpen時に同階層の「Module一覧テキストファイル」からModuleを読み込み。

②開いたブックのModuleは自由に改変や追加可能。

③Close時に現在あるModuleを「Module一覧テキストファイル」に新規に書き込み（旧ファイル削除）、更に任意の場所へModuleを保存後、Moduleを全て削除する。

①～②～③～①で常に最新Module群に保てる。

改変や新規追加したModuleは上書きされ最新になる。

他のブックとModuleが重複しない他、共有出来便利。

１度作成したModuleは閉じた時登録される。

登録後に開いて不要なModuleを削除すると再度起動時には読み込まれない。（Moduleは指定フォルダに残っている）

再び必要となったModuleはフォルダからドラッグ＆ドロップでインポート可能。（探すのが大変ですから名前付けの定義を決めておいた方が良い）

SubをFunctionを同じフォルダ内で管理ができる。

※ここではModuleだけを対象にしていますがSheet、UserForm、ClassModuleも対象にすることが可能。

※Module名は自由ですがいちいち開かなくても内容が判るような名前付けが賢明です。

~~※閉じる際に「保存する」を選択して下さい。（Module名に[1]が付加され、保存Moduleが増える）~~自動保存されます。

※閉じた状態なら約58kb

下のコードをコピペでThisWorkbookにペーストして下さい。

Moduleが一つも無い場合のエラー回避はしていません。

すべてThisWorkbookに記述

Option Explicit

'#パラメータ
Const ComponentsPath As String = "C:\VBAbas\"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'****************************************************
'閉じる前に実行するイベント
'****************************************************

ThisProJectComponentCopy
'コンポーネント削除
ComponentsDelete
ThisWorkbook.Save
'ThisWorkbook.Close saveChanges:=True

End Sub

Private Sub Workbook_Open()
'****************************************************
'ModuleやClass・UserFormを一覧から自動インポートする
'****************************************************
'本ブックと同じ階層にテキストを保存。
'行毎に記入の事
'全て「ThisWorkbook」に記述のこと
'#パラメータ
Dim TxtPath As String, i As Long
Dim CharacterDB() As String

TxtPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".txt"
'If MsgBox("", vbYesNo) = vbYes Then
    'ModuleやClass・UserFormを削除する
    ComponentsDelete

    '指定ファイルの存在を確認する
    If FileExistence(TxtPath) = False Then
        MsgBox "Not File! " & TxtPath
        Exit Sub
    End If
    '指定ファイルを読み込む
    Call FileInput(TxtPath, CharacterDB())
    'Moduleをインポートする
    For i = LBound(CharacterDB) To UBound(CharacterDB)
        ComponentImport (CharacterDB(i))
    Next i

'End If
End Sub

Private Function FileExistence(TxtPath As String) As Boolean
'**************************************************
'指定ファイルの存在を確認する
'**************************************************
    If Dir(TxtPath) = "" Then
        FileExistence = False
    Else
        FileExistence = True
    End If
End Function

Private Sub FileInput(ByVal TxtPath As String, ByRef CharacterDB() As String)
'**************************************************
'指定ファイルを１行づつ読み込む
'**************************************************
Dim CharacterString As String
Dim FileNumber As Integer, i As Long
    FileNumber = FreeFile
    Open TxtPath For Input As #FileNumber
        Do Until EOF(FileNumber) '末尾に達するまで
            '取得文字を変数CharacterStringに格納
            Line Input #FileNumber, CharacterString
            '文字があるか確認
            If Len(CharacterString) > 0 Then
                '処理
                ReDim Preserve CharacterDB(i)
                CharacterDB(i) = (ComponentsPath & CharacterString)
                i = i + 1
            End If
        Loop
    Close #FileNumber
End Sub

Private Sub ComponentImport(ComponentsPathName As String)
'**************************************************
'ModuleやClass・UserFormをインポートする
'**************************************************
'定数 ComponentsPathName：bas等の格納パス&名前

Application.StatusBar = "ComponentImport:" & ComponentsPathName

    If Dir(ComponentsPathName) = "" Then
        MsgBox "Not Module! " & ComponentsPathName
        Exit Sub
    Else
        ThisWorkbook.VBProject.VBComponents.Import ComponentsPathName
    End If

End Sub

Private Sub ComponentsDelete()
'************************************
'ModuleやClass・UserFormを削除する
'************************************
'※自分も削除されます。ここでは.Type=100以外なので削除されません。
'NoDeleteObjTyp:削除非対象コレクション
'1  :Module
'2  :ClassModule
'3  :UserForm
'100:Workbook & Sheet

Application.StatusBar = "ComponentsDelete......"

Dim Obj As Object, NoDeleteObjTyp As Integer
NoDeleteObjTyp = 100

For Each Obj In ThisWorkbook.VBProject.VBComponents

    If Obj.Type <> NoDeleteObjTyp Then
        ThisWorkbook.VBProject.VBComponents.Remove Obj
    End If

Next Obj

End Sub

Sub ThisProJectComponentCopy()
'ObjectName:M_ThisProJectComponentCopy
'***************************************
'実行プロシージャ
'***************************************
Dim TxtPath As String
'Dim ComponentPath As String
TxtPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".txt"

Dim ComponentsName() As String
Dim str As String, i As Integer
'現在のComponent一覧取得
Call ComponentsGetName(ComponentsName)
'前回のテキスト削除
FileKill TxtPath
'新規テキスト入力
For i = LBound(ComponentsName) To UBound(ComponentsName)
FileAppend TxtPath, ComponentsName(i)
Next i
'Componentを全てエクスポート(コピー)する
ComponentsExport ComponentsPath

End Sub

Sub ComponentsExport(ObjPath As String)
'ObjectName:M_ComponentsExport
'***************************************************************
'ModuleやClass・UserFormを別ファイルにエクスポート(コピー)する
'***************************************************************
'※自分もコピーされます。
'※対象はプロジェクト全体
'ExportObjTyp:対象コレクション

Dim Obj As Object, ExportObjTyp As Integer
Dim ObjName As String '対象コレクション名

ExportObjTyp = 1 '対象コレクション(Module)

Dim Extension(100) As String '拡張子(Select Caseの方がベター)
Extension(1) = ".bas"   '1  :Module
Extension(2) = ".cls"   '2  :ClassModule
Extension(3) = ".frm"   '3  :UserForm
Extension(100) = ".cls" '100:Workbook & Sheet

For Each Obj In ThisWorkbook.VBProject.VBComponents

    If Obj.Type = ExportObjTyp Then
        ObjName = Obj.Name
        Obj.Export (ObjPath & ObjName & Extension(ExportObjTyp))
    End If

Next Obj

End Sub

Sub ComponentsGetName(ByRef ComponentsName() As String)
'ObjectName:M_ComponentsGetName
'***************************************************************
'ModuleやClass・UserForm名を取得する
'***************************************************************
'※自分も対象にされます。
'※対象はプロジェクト全体
'ObjTyp:対象コレクション

Dim Obj As Object, ObjTyp As Integer
Dim i As Integer

ObjTyp = 1 '対象コレクション(Module)

Dim Extension(100) As String '拡張子(Select Caseの方がベター)
Extension(1) = ".bas"   '1  :Module
Extension(2) = ".cls"   '2  :ClassModule
Extension(3) = ".frm"   '3  :UserForm
Extension(100) = ".cls" '100:Workbook & Sheet

i = 0 '初期化

For Each Obj In ThisWorkbook.VBProject.VBComponents

    If Obj.Type = ObjTyp Then
        ReDim Preserve ComponentsName(i)
        ComponentsName(i) = Obj.Name & Extension(ObjTyp)
        i = i + 1
    End If

Next Obj

End Sub

Sub FileKill(DelPath As String)
'ObjectName:M_FileKill
'*********************************
'Killを使用しファイルを削除
'*********************************

On Error Resume Next

Kill DelPath

On Error GoTo 0

End Sub

Sub FileAppend(TxtPath As String, str As String)
'ObjectName:M_FileAppend
'*******************************************************************************
'指定パスのテキストファイルに追加
'*******************************************************************************

    Dim n As Long
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    Open TxtPath For Append As #n
        Print #n, str
    Close #n

' キーワード処理             モード
' Input   読み込み           入力モード
' Output  書き込み           出力モード
' Append  書き込み           追加モード
' Random  読み込み/書き込み  ランダムアクセスモード(データベースの
'                            データファイルにアクセスするモード)
' Binary  読み込み/書き込み  バイナリモード(ファイルのデータを一気
'                            に読み込む)
End Sub

制御既に開かれているブックがあれば閉じる

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub OpenExcelCount()
Dim I, ThisName As String, A As Boolean
A = False
ThisName = ThisWorkbook.Name
If Workbooks.Count <> 1 Then
MsgBox "既に開かれているブックが " & Workbooks.Count - 1 & " 個あります。" & vbCr & vbCr & "閉じてから実行してください。", vbCritical, ThisName
A = True
For Each I In Workbooks
If ThisName <> I.Name Then
MsgBox I.Name & "を閉じてください。", vbCritical, ThisName
End If
Next

End If

If A = True Then
MsgBox "一旦" & ThisWorkbook.Name & "を閉じます。", vbCritical, ThisWorkbook.Name
ThisWorkbook.Close
End If
End Sub

制御キーボード操作禁止など

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Function fnc製品モード() As Boolean
'*******************************************************************************
'開発モード/製品モード（納品時に変更）
'*******************************************************************************
    fnc製品モード = False
End Function

Public Sub 画面を更新しない()
'*******************************************************************************
'画面を更新しない
'*******************************************************************************
    Application.ScreenUpdating = False
End Sub

Public Sub 画面を更新する()
'*******************************************************************************
'画面を更新する
'*******************************************************************************
    Application.ScreenUpdating = True
End Sub

Public Sub キーボード操作禁止()
'*******************************************************************************
'キーボード操作禁止
'*******************************************************************************
    Application.Interactive = False
End Sub

Public Sub キーボード操作禁止解除()
'*******************************************************************************
'キーボード操作禁止解除
'*******************************************************************************
    Application.Interactive = True
End Sub

Public Sub アプリ表示()
'*******************************************************************************
'アプリ表示
'*******************************************************************************
    Application.Visible = True
End Sub

Public Sub アプリ非表示()
'*******************************************************************************
'アプリ非表示
'*******************************************************************************
    Application.Visible = False
End Sub

制御キーコードの定数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

キーコードの定数

次の定数は､実際の値の代わりにコード内のどの部分でも使うことができます｡
定数	値	内容
vbKeyLButton	0x1	マウスの左ボタン
vbKeyRButton	0x2	マウスの右ボタン
vbKeyCancel	0x3	Cancel キー
vbKeyMButton	0x4	マウスの右ボタン
vbKeyBack	0x8	BackSpace キー
vbKeyTab	0x9	Tab キー
vbKeyClear	0xC	Clear キー
vbKeyReturn	0xD	Enter キー
vbKeyShift	0x10	Shift キー
vbKeyControl	0x11	Ctrl キー
vbKeyMenu	0x12	Alt キー
vbKeyPause	0x13	Pause キー
vbKeyCapital	0x14	CapsLock キー
vbKeyEscape	0x1B	Esc キー
vbKeySpace	0x20	Space キー
vbKeyPageUp	0x21	PageUp キー
vbKeyPageDown	0x22	PageDown キー
vbKeyEnd	0x23	End キー
vbKeyHome	0x24	Home キー
vbKeyLeft	0x25	← キー
vbKeyUp	0x26	↑ キー
vbKeyRight	0x27	→ キー
vbKeyDown	0x28	↓ キー
vbKeySelect	0x29	Select キー
vbKeyPrint	0x2A	PrintScreen キー
vbKeyExecute	0x2B	Execute キー
vbKeySnapshot	0x2C	Snapshot キー
vbKeyInsert	0x2D	Ins キー
vbKeyDelete	0x2E	Del キー
vbKeyHelp	0x2F	Help キー
vbKeyNumlock	0x90	NumLock キー

A ～ Z キーは、ASCII コードの A ～ Z に相当するものと同じです。
定数	値	内容
vbKeyA	65	A キー
vbKeyB	66	B キー
vbKeyC	67	C キー
vbKeyD	68	D キー
vbKeyE	69	E キー
vbKeyF	70	F キー
vbKeyG	71	G キー
vbKeyH	72	H キー
vbKeyI	73	I キー
vbKeyJ	74	J キー
vbKeyK	75	K キー
vbKeyL	76	L キー
vbKeyM	77	M キー
vbKeyN	78	N キー
vbKeyO	79	O キー
vbKeyP	80	P キー
vbKeyQ	81	Q キー
vbKeyR	82	R キー
vbKeyS	83	S キー
vbKeyT	84	T キー
vbKeyU	85	U キー
vbKeyV	86	V キー
vbKeyW	87	W キー
vbKeyX	88	X キー
vbKeyY	89	Y キー
vbKeyZ	90	Z キー

0 ～ 9 キーは、ASCII コードの 0 ～ 9 に相当するものと同じです。
定数	値	内容
vbKey0	48	0 キー
vbKey1	49	1 キー
vbKey2	50	2 キー
vbKey3	51	3 キー
vbKey4	52	4 キー
vbKey5	53	5 キー
vbKey6	54	6 キー
vbKey7	55	7 キー
vbKey8	56	8 キー
vbKey9	57	9 キー

次の定数は、テンキーの各キーを表します。
定数	値	内容
vbKeyNumpad0	0x60	0 キー
vbKeyNumpad1	0x61	1 キー
vbKeyNumpad2	0x62	2 キー
vbKeyNumpad3	0x63	3 キー
vbKeyNumpad4	0x64	4 キー
vbKeyNumpad5	0x65	5 キー
vbKeyNumpad6	0x66	6 キー
vbKeyNumpad7	0x67	7 キー
vbKeyNumpad8	0x68	8 キー
vbKeyNumpad9	0x69	9 キー
vbKeyMultiply	0x6A	アスタリスク (*) キー
vbKeyAdd	0x6B	プラス (+) キー
vbKeySeparator	0x6C	Enter キー
vbKeySubtract	0x6D	マイナス (-) キー
vbKeyDecimal	0x6E	ピリオド (.) キー
vbKeyDivide	0x6F	スラッシュ (/) キー

次の定数は、ファンクションキーの各キーを表します。
定数	値	内容
vbKeyF1	0x70	F1 キー
vbKeyF2	0x71	F2 キー
vbKeyF3	0x72	F3 キー
vbKeyF4	0x73	F4 キー
vbKeyF5	0x74	F5 キー
vbKeyF6	0x75	F6 キー
vbKeyF7	0x76	F7 キー
vbKeyF8	0x77	F8 キー
vbKeyF9	0x78	F9 キー
vbKeyF10	0x79	F10 キー
vbKeyF11	0x7A	F11 キー
vbKeyF12	0x7B	F12 キー
vbKeyF13	0x7C	F13 キー
vbKeyF14	0x7D	F14 キー
vbKeyF15	0x7E	F15 キー
vbKeyF16	0x7F	F16 キー

制御キーボードSendKeysを使う

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'◆構文 SendKeys string[, wait]
'
'string 必ず指定します。転送するキーコードを表す文字列式を指定します。
'
'Wait 省略可能です｡
'名前付き引数 string の転送によって行われる処理が終了するまで、実行を一時中断するかどうかを
'次に示すブール型 (Boolean) の値で指定します。
'False (既定値) プロシージャの終了を待たずに次の行に制御を移します。
'True 処理が終了するまで実行を一時中断します。
'
'解説キーボードの各キーは 1 つ以上の文字で表されます。
'キーボード上の文字を渡すには､キーの指定にその文字を使います｡
'たとえば、キーボード上の文字 A を表すには、名前付き引数 string に "A" を指定します。
'複数の文字を表すには､文字を連続して設定します｡
'たとえば、文字 A、B、C を表すには、名前付き引数 string に "ABC" と指定します。
'
'プラス記号 (+)、キャレット (^)、パーセント記号 (%)、チルダ (~)、かっこ (( )) はそれぞれ SendKeys ステートメントで
'特別な意味を持っています｡
'これらの文字を渡すには、文字を中かっこ ({ }) で囲んで指定します。
'たとえば、プラス記号は {+} のように指定します。
'角かっこ ([ ]) は SendKeys ステートメントでは特別な意味を持ちませんが、
'Microsoft Windows の他のアプリケーションで特別な意味を持つ場合があるので、中かっこで囲みます。
'これは、ダイナミックデータエクスチェンジ (DDE) を行うときに角かっこが重要になることがあるためです。
'文字として中かっこを渡すには、{{} または {}} を使います。
'
'（help抜粋）

'◆キーコード
'・BackSpace {BACKSPACE}、{BS}、または {BKSP}
'・Ctrl + Break {BREAK}
'・CapsLock {CAPSLOCK}
'・Del または Delete {DELETE} または {DEL}
'・↓ {DOWN}
'・End {END}
'・Enter {ENTER}または {~}
'・Esc {ESC}
'・Help {HELP}
'・Home {HOME}
'・Ins または Insert {INSERT} または {INS}
'・← {LEFT}
'・NumLock {NUMLOCK}
'・PageDown {PGDN}
'・PageUp {PGUP}
'・PrintScreen {PRTSC}
'・→ {RIGHT}
'・ScrollLock {SCROLLLOCK}
'・Tab {TAB}
'・↑ {UP}
'・F1 {F1}
'・F2 {F2}
'・F3 {F3}
'・F4 {F4}
'・F5 {F5}
'・F6 {F6}
'・F7 {F7}
'・F8 {F8}
'・F9 {F9}
'・F10 {F10}
'・F11 {F11}
'・F12 {F12}
'・F13 {F13}
'・F14 {F14}
'・F15 {F15}
'・F16 {F16}

'◆SendKeys ステートメントの使用例
'SendKeys ステートメントは、Macintosh では実行できません。

Dim ReturnValue, I
ReturnValue = Shell("CALC.EXE", 1) ' 電卓を実行します。
AppActivate ReturnValue ' 電卓をアクティブにします。
For I = 1 To 20 ' ループカウンタを設定します。
SendKeys I & "{+}", True ' 電卓にキーコードを転送して、
Next I ' I の値に 1 を加算します。
SendKeys "=", True ' 和を求めます。
SendKeys "%{F4}", True ' Alt + F4 キーを転送して電卓を終了します。

制御バーコード

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'BarCodeCtrl
'UserForm → PrintForm

制御タイマー実行コードを一時的に止める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Dim thisTime As Single, stopTimer As Single

stopTimer = 3 ' 中断時間(秒)設定
thisTime = Timer ' 中断の開始時刻を設定
Do While Timer < thisTime + stopTimer
DoEvents ' 他のプロセスに制御
Loop

MsgBox "end"

制御フォームの[×]ボタンを無効にする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub UserForm_QueryClose(CANCEL As Integer, CloseMode As Integer)

    If CloseMode = 0 Then

        MsgBox "[CLOSE]ボタンで閉じて下さい", vbExclamation, "AIEI"
        CANCEL = True

    End If

End Sub

制御 ModuleやClass・UserFormを削除する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub DeleteComponents()
'************************************
'ModuleやClass・UserFormを削除する
'************************************
'※自分も削除されます。
'NoDeleteObjTyp:削除非対象コレクション
'1  :Module
'2  :ClassModule
'3  :UserForm
'100:Workbook & Sheet
Dim Obj As Object, NoDeleteObjTyp As Integer
NoDeleteObjTyp = 100

For Each Obj In ThisWorkbook.VBProject.VBComponents

    If Obj.Type <> NoDeleteObjTyp Then
        ThisWorkbook.VBProject.VBComponents.Remove Obj
    End If

Next Obj

End Sub

VBProject プロパティ

指定されたブックの Visual Basic プロジェクトを表す VBProject オブジェクトを返します。
VBProject プロパティの使用例
次の使用例は、ブックの Visual Basic プロジェクトの名前を変更します。
ThisWorkbook.VBProject.Name = "TestProject"

VBComponents プロパティ

プロジェクト内に含まれるコンポーネントのコレクションを返します｡
解説
VBComponents コレクションを使用すると、プロジェクト内のコンポーネントを使用したり、追加したり、あるいは削除することができます。
フォームモジュール、標準モジュールまたはクラスモジュールがコンポーネントとして挙げられます。
VBComponent コレクションは、For... Each ステートメントで使用できる標準的なコレクションです。
Parent プロパティを使用すると、VBComponents コレクションを含んでいるオブジェクトが返されます。
Visual Basic for Applications Edition では、Import メソッドを使用すると、コンポーネントのファイルをプロジェクトに追加することができます。

制御 ModuleやClass・UserFormをエクスポート(ファイル保存)する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ImportComponent(strPath As String)
'***********************************************
'制御 ModuleやClass・UserFormをインポートする
'***********************************************

ThisWorkbook.VBProject.VBComponents.Import strPath

End Sub

Private Sub test()
ImportComponent ThisWorkbook.Path & "\Module2.bas"
End Sub

Export メソッド (VBA アドインオブジェクトモデル)

コンポーネントを別のファイルとして保存します。
構文
object.Export(filename)
Export メソッドの構文は、次の指定項目から構成されます。
指定項目内容
- object 必ず指定します。
  - オブジェクトへの参照を表すオブジェクト式を指定します。
- filename 必ず指定します。
  - コンポーネントをエクスポートするファイルの名前を表す文字列型 (String) の値を指定します。
解説
Export メソッドを使って、コンポーネントを別のファイルとして保存するときは、既存のファイルの名前と重複しない名前を使用します(上書きされます)。
~~既存のファイルと同じ名前を使用するとエラーになります~~。
Export メソッドの使用例
次の例は、test.bas という名前のファイルを作成し、Export メソッドを使用して VBComponents(1) コードモジュールの内容をファイルにコピーします。
Application.VBE.ActiveVBProject.VBComponents(1).Export("test.bas")

制御 ModuleやClass・UserFormを一覧から自動インポートする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub basImport(basPath As String)
'**************************************************
'ModuleやClass・UserFormを一覧からインポートする
'**************************************************
'引数 basPath：指定テキストファイル
'定数 basFlPath：bas等の格納パス

Dim i, str As String, basName As String
Dim basFlPath As String
basFlPath = "C:\VBAbas\" '#パラメータ

    DeleteComponents

    If Dir(basPath) = "" Then
        MsgBox "Not File! " & basPath
        Exit Sub
    End If

    i = FreeFile
    Open basPath For Input As #i
        Do Until EOF(i)
            Line Input #i, str
            If Len(str) > 0 Then
                basName = basFlPath & str
                If Dir(basName) = "" Then
                    MsgBox "Not Module! " & basName
                    Exit Do
                Else
                    ImportComponent basName
                End If
            End If
        Loop
    Close #i

    ThisWorkbook.Save

End Sub

Private Sub ImportComponent(strPath As String)
'***********************************************
'ModuleやClass・UserFormをインポートする
'***********************************************

ThisWorkbook.VBProject.VBComponents.Import strPath

End Sub

情報関連変更有無調査確認保存

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Sub psb変更有無調査確認保存(Mybook As Workbook, MySheet As Worksheet)
'*******************************************************************************
'変更有無調査確認保存
'*******************************************************************************
    Dim str(3) As String
    If Mybook.Saved = False Then        'False（変更を未保存）なら
        str(1) = "行った処理を有効にしますか？"
        str(2) = "※[いいえ]を選択した場合、行った処理は破棄されます。"
        str(3) = fncブック名(Mybook)
        If MsgBox(str(1) & vbCr & vbCr & str(2), vbExclamation + vbYesNo, str(3)) = vbYes Then
            Call psbブック保護(Mybook)
            Call psbシート保護(MySheet)
            Mybook.Save                    '上書き保存
            Application.DisplayAlerts = False           'メッセージを出さない
            Mybook.Close                '閉じる
        Else
            Application.DisplayAlerts = False           'メッセージを出さない
            Mybook.Close                '閉じる
        End If
    Else
      Mybook.Close
    End If
End Sub

情報関連指定フォルダ内のすべてのファイル(JPG・MP3等)の拡張プロパティを取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub PropertyFileInFolder()
'*******************************************************
'指定フォルダ内のすべてのファイルの拡張プロパティを取得
'*******************************************************
'JPGやMP3ファイルのプロパティを取得
'2010.03若干修正

Dim objCRT As Object, objFldr As Object, i As Byte
Dim strPrprty(40) As String 'ファイル情報の項目名をセット
Dim strFlNm As Object, str As String, folPath As Variant

folPath = "C:\Air Supply"

'ActiveX オブジェクトへの参照
Set objCRT = CreateObject("Shell.Application")
'名前空間の名前を宣言
Set objFldr = objCRT.Namespace("" & folPath & "")

For i = 0 To 40
    'ファイル情報の項目名をセット(取得).Items
    '[GetDetailsOf]ファイル情報を取得(ファイル名.Items,情報番号)
    strPrprty(i) = objFldr.GetDetailsOf(objFldr.Items, i)
Next

For Each strFlNm In objFldr.Items
    str = "" 'クリア
    For i = 0 To 40
        str = str & i & vbTab & strPrprty(i) _
        & vbTab & objFldr.GetDetailsOf(strFlNm, i) & vbCr
        '[GetDetailsOf]ファイル情報を取得(ファイル名,情報番号)
    Next
    MsgBox str
    Debug.Print str
Next

'--------------------------------------------------

'【JPG表示項目一覧】
'0   名前    1.jpg
'1   サイズ  9 KB
'2   種類    JPEG イメージ
'3   更新日時    2008/04/11 17:14
'4   作成日時    2009/10/14 14:20
'5   アクセス日時    2009/10/14 16:12
'6   属性
'7   状態
'8   所有者 --------
'9   作成者
'10  タイトル
'11  表題
'12  カテゴリ
'13  ページ数
'14  コメント
'15  著作権
'16  アーティスト
'17  アルバムのタイトル
'18  年
'19  トラック番号
'20  ジャンル
'21  長さ
'22  ビットレート
'23  保護
'24  カメラのモデル
'25  写真の撮影日
'26  大きさ  282 x 100
'27      282 ピクセル
'28      100 ピクセル
'29  この回のタイトル
'30  プログラムの説明
'31
'32  オーディオサンプルサイズ
'33  オーディオサンプルレート
'34  チャンネル
'35  会社名
'36  説明
'37  ファイルバージョン
'38  製品名
'39  製品バージョン
'40  キーワード

'--------------------------------------------------

'【MP3表示項目一覧】
'0   名前    02 Even the Nights Are Better.mp3
'1   サイズ  4,525 KB
'2   種類    MP3 形式サウンド
'3   更新日時    2009/04/07 8:19
'4   作成日時    2008/09/08 8:21
'5   アクセス日時    2009/10/14 16:24
'6   属性 a
'7   状態オンライン
'8   所有者 --------
'9   作成者  Air Supply
'10  タイトル    Even the Nights Are Better
'11  表題
'12  カテゴリ Rock
'13  ページ数
'14  コメント
'15  著作権
'16  アーティスト    Air Supply
'17  アルバムのタイトル Now And Forever
'18  年 1982
'19  トラック番号 2
'20  ジャンル Rock
'21  長さ    0:03:58
'22  ビットレート   192kbps
'23  保護いいえ
'24  カメラのモデル
'25  写真の撮影日
'26  大きさ
'27
'28
'29  この回のタイトル
'30  プログラムの説明
'31
'32  オーディオサンプルサイズ  0 ビット
'33  オーディオサンプルレート  44 KHz
'34  チャンネル
'35  会社名
'36  説明
'37  ファイルバージョン
'38  製品名
'39  製品バージョン
'40  キーワード

End Sub

Sub ファイルの一覧を取得する()
'*******************************************************************************
'ファイルの一覧を取得する
'*******************************************************************************
    Dim buf As String, i As Byte, strPath As Variant
    Dim strPthNm As String
    strPath = "C:\Air Supply"
    buf = Dir(strPath & "\")
    Do While buf <> ""
        For i = 0 To 33
        MsgBox FileProperty(strPath, buf, i)
        Next i
        buf = Dir()
    Loop
End Sub

Function FileProperty(strPath As Variant, strFileName As String, PropertyNo As Byte) As String
'*******************************************************
'指定ファイルの拡張プロパティを取得
'*******************************************************
'JPGやMP3ファイルのプロパティを取得

Dim objCRT As Object, objFldr As Object, objFldrItm As Object

'ActiveX オブジェクトへの参照
Set objCRT = CreateObject("Shell.Application")
''名前空間の名前を宣言
Set objFldr = objCRT.Namespace("" & strPath & "")
Set objFldrItm = objFldr.ParseName(strFileName)

    '[GetDetailsOf]ファイル情報を取得(ファイル名,情報番号)
    FileProperty = objFldr.GetDetailsOf(objFldrItm, PropertyNo)

'--------------------------------------------------

'【表示項目一覧】
'0   名前
'1   サイズ
'2   種類
'3   更新日時
'4   作成日時
'5   アクセス日時
'6   属性
'7   状態
'8   所有者
'9   作成者
'10  タイトル
'11  表題
'12  カテゴリ
'13  ページ数
'14  コメント
'15  著作権
'16  アーティスト
'17  アルバムのタイトル
'18  年
'19  トラック番号
'20  ジャンル
'21  長さ
'22  ビットレート
'23  保護
'24  カメラのモデル
'25  写真の撮影日
'26  大きさ  282 x 100
'27      282 ピクセル
'28      100 ピクセル
'29  この回のタイトル
'30  プログラムの説明
'31
'32  オーディオサンプルサイズ
'33  オーディオサンプルレート
'34  チャンネル
'35  会社名
'36  説明
'37  ファイルバージョン
'38  製品名
'39  製品バージョン
'40  キーワード

End Function

制御 Excelappliを消す(アプリケーションを一時的に隠す)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'UserForm1

Private Sub UserForm_Initialize()
'開始処理

Excel.Application.Visible = False
'画面変更しない
Application.ScreenUpdating = False
'アプリのステータスを表示
Application.StatusBar = "○○○システム"
'アプリのキャピション変更
Application.Caption = "○○○システム"

'必要ファイルのオープン-------------------------------------------->>

Dim wbPersonal
Dim wbPersonal1
Dim BookPath As String
Dim PathBOK As String
Dim TrgtBOK As String
Dim TrgtBOK1 As String

PathBOK = ".xls"

TrgtBOK = ".xls"
TrgtBOK1 = ".xls"

    On Error Resume Next
    Set wbPersonal = Workbooks(TrgtBOK)
    Set wbPersonal1 = Workbooks(TrgtBOK1)
    On Error GoTo 0
    If IsObject(wbPersonal) Then
        MsgBox wbPersonal.Name & _
        "はすでに開いています。OKボタンを押してください。", vbCritical, "注意"
        Workbooks(TrgtBOK).Close SaveChanges:=False
    End If

    If IsObject(wbPersonal1) Then
        MsgBox wbPersonal1.Name & _
        "はすでに開いています。OKボタンを押してください。", vbCritical, "注意"
        Workbooks(TrgtBOK1).Close SaveChanges:=False
    End If

    Set wbPersonal = Nothing
    Set wbPersonal1 = Nothing

    'パス取得
    BookPath = Workbooks(PathBOK).Path

    '必要ファイルをオープン
    With Workbooks
        .Open Filename:=BookPath & "\" & TrgtBOK, ReadOnly:=False
    End With
    '必要ファイルをオープン
    With Workbooks
        .Open Filename:=BookPath & "\" & TrgtBOK1, ReadOnly:=False
    End With
End Sub

Private Sub UserForm_QueryClose(CANCEL As Integer, CloseMode As Integer)
'×ボタン制御
    If CloseMode = 0 Then
        MsgBox "{ CLOSE }ボタンで閉じて下さい", vbExclamation, "jp-ia"
        CANCEL = True
    End If
End Sub

Private Sub CommandButton8_Click()
'終了ボタン
    'メッセージ
    If MsgBox("システムを終了します。", vbOKCancel, "システム終了") = _
    vbCancel Then Exit Sub

    '画面更新しない
    Application.ScreenUpdating = False

    '各設定を元に戻す
    Workbooks("PDP.v2.00.xls").Activate
    Workbooks("PDP.v2.00.xls").Protect Windows:=False

    'メニューバーコントロールを戻す。
    Application.CommandBars("worksheet menu bar").Reset

    'スクリーンを戻す。
    Application.DisplayFullScreen = False

    '初期表示画面にセッティング
    Workbooks("PDP.v2.00.xls").Activate
    Sheets("OPEN").Select

    'メインメニュー閉じる
    Unload Me

    '現在開いているBOOKを全て保存しEXCELを閉じます。
    Dim w As Workbook
    For Each w In Application.Workbooks
    w.Save
    Next w

MsgBox "保存処理時間を10秒程度要します。", 0, "システム終了"

Dim thisTime As Single, stopTimer As Single

stopTimer = 10 ' 中断時間(秒)設定
thisTime = Timer ' 中断の開始時刻を設定
Do While Timer < thisTime + stopTimer
DoEvents ' 他のプロセスに制御
Loop

MsgBox "この後、全ての管理システムが終了します。" _
& vbCr & vbCr & "お疲れ様でした", 0, "システム終了"

Application.Quit

End Sub

制御 ModuleやClass・UserFormをインポートする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub test()
ImportComponent ThisWorkbook.Path & "\Module2.bas"
End Sub

VBProject プロパティ

指定されたブックの Visual Basic プロジェクトを表す VBProject オブジェクトを返します。
VBProject プロパティの使用例
次の使用例は、ブックの Visual Basic プロジェクトの名前を変更します。
ThisWorkbook.VBProject.Name = "TestProject"

VBComponents プロパティ

プロジェクト内に含まれるコンポーネントのコレクションを返します｡
解説
VBComponents コレクションを使用すると、プロジェクト内のコンポーネントを使用したり、追加したり、あるいは削除することができます。
フォームモジュール、標準モジュールまたはクラスモジュールがコンポーネントとして挙げられます。
VBComponent コレクションは、For... Each ステートメントで使用できる標準的なコレクションです。
Parent プロパティを使用すると、VBComponents コレクションを含んでいるオブジェクトが返されます。
Visual Basic for Applications Edition では、Import メソッドを使用すると、コンポーネントのファイルをプロジェクトに追加することができます。

Import メソッド (VBA アドインオブジェクトモデル)

コンポーネントをファイルからプロジェクトに追加します。新しく追加されたコンポーネントを返します。
構文
object.Import(filename) As VBComponent
Import メソッドの構文は、次の指定項目から構成されます。
指定項目内容
- object 必ず指定します。
  - オブジェクトへの参照を表すオブジェクト式を指定します。
- filename 必ず指定します。
  - インポートするコンポーネントのファイル名とパスを表す文字列型 (String) の値を指定します。
解説
Import メソッドを使用して、コンポーネント、フォーム、モジュール、クラスなどをプロジェクトに追加できます。
Import メソッドの使用例
次の例は、Import メソッドを使用して、test.bas ファイルの内容をコードモジュールにコピーします。
Application.VBE.ActiveVBProject.VBComponents.Import("test.bas")

制御アプリケーションキャピション変更

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Application.Caption = "システム"

制御 ModuleやClass・UserForm名を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub GetComponentsName(ByRef ComponentsName() As String)
'***************************************************************
'ModuleやClass・UserForm名を取得する
'***************************************************************
'※自分も対象にされます。
'※対象はプロジェクト全体
'ObjTyp:対象コレクション

Dim ObjPath As String
ObjPath = ThisWorkbook.Path & "\"

Dim Obj As Object, ObjTyp As Integer
Dim i As Integer

ObjTyp = 1 '対象コレクション(Module)

Dim Extension(100) As String '拡張子(Select Caseの方がベター)
Extension(1) = ".bas"   '1  :Module
Extension(2) = ".cls"   '2  :ClassModule
Extension(3) = ".frm"   '3  :UserForm
Extension(100) = ".cls" '100:Workbook & Sheet

i = 0 '初期化

For Each Obj In ThisWorkbook.VBProject.VBComponents

    If Obj.Type = ObjTyp Then
        ReDim Preserve ComponentsName(i)
        ComponentsName(i) = Obj.Name & Extension(ObjTyp)
        i = i + 1
    End If

Next Obj

End Sub

Private Sub test()
Dim ComponentsName() As String
Dim str As String, i As Integer

Call GetComponentsName(ComponentsName)

For i = LBound(ComponentsName) To UBound(ComponentsName)
str = str & i & vbTab & ComponentsName(i) & vbCr
Next i

MsgBox str

End Sub

制御 WAVサウンド鳴らす(API)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Sub my_wave1()
Dim myRtn As Long
myRtn = sndPlaySound("C:\My Documents\TEST\Test.wav", 1)
End Sub

制御アプリケーションを非表示

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Excel.Application.Visible = False

制御アプリケーションステータスを表示

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Application.StatusBar = "システム"

制御エクセルの「×」を消す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'’「Find-Window」API関数を使用しウィンドウを操作する場合、ハンドル取得に必要
'’「GetWindowLong」ウィンドウプロパティ取得

Declare Function findwindow Lib "user32" _
Alias "FindWindowA" (ByVal lpclassname As String, ByVal lowindowname As String) As Long

Declare Function getwindowlong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nindex As Long) As Long

Declare Function setwindowlong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long

Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Const gwl_style = (-16)
Const ws_sysmenu = &H80000

Sub DisappearCloseButton()

Dim myRes As Long, myWindowHandle As Long, myWindowStyle As Long, myClassName As String

myClassName = "xlmain"

myWindowHandle = findwindow(myClassName, Application.Caption)
myWindowStyle = getwindowlong(myWindowHandle, gwl_style)
myWindowStyle = myWindowStyle And (Not ws_sysmenu)
myRes = setwindowlong(myWindowHandle, gwl_style, myWindowStyle)
myRes = DrawMenuBar(myWindowHandle)

Application.WindowState = xlMaximized

End Sub

参照設定参照設定されているライブラリを検索取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub RefRemoveAcquisition()
'**************************************
'参照設定されているライブラリを検索取得
'**************************************
Dim objBok As Workbook
Dim objReferences As Object
Dim strMSG As String
Dim strRefName As String
Dim strRefDscrp As String

Set objBok = ThisWorkbook

For Each objReferences In objBok.VBProject.References
    strRefName = objReferences.Name
    strRefDscrp = objReferences.Description
    strMSG = strMSG & strRefName & vbTab & strRefDscrp & vbCr
    Debug.Print strRefName & "[" & strRefDscrp & "]"
Next objReferences

MsgBox strMSG, 0, "参照設定済ライブラリ"

'【Description】
'　オブジェクトに関連付けられている説明の文字列を設定又は取得
End Sub

参照設定 FSO参照設定

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub RuntimeFSOSet()
'*************************************************
'FileSystemObject参照設定
'*************************************************
'名称:Microsoft Scripting Runtime

On Error GoTo MyErr:
'参照設定
ThisWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\system32\scrrun.dll"
MyErr:

End Sub

参照設定ライブラリファイルの参照の追加､削除

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'Rem ■Excel 97 以降ライブラリファイルの参照の追加、削除する■
'
'Rem ■c:\program files\microsoft office\office\msacc8.olb存在仮定■

'Rem Microsoft Access 8.0 Object Library を参照設定追加

  Sub add_ref()
      Application.VBE.activeVBProject.References. _
             AddFromFile "c:\program files\microsoft office\office\msacc8.olb"
  End Sub

'Rem Microsoft Access 8.0 Object Library を参照設定削除

  Sub del_ref()
      Application.VBE.activeVBProject.References.Remove _
             Application.VBE.activeVBProject.References("Access")
  End Sub

'Rem 新規ブックにＤＡＯ3.5 参照設定追加

    Sub add_ref2()
        Application.VBE.activeVBProject.References. _
             AddFromFile "c:\program files\common files\microsoft shared\dao\dao3032.dll"
    End Sub

'Rem 指定ブックにＤＡＯ3.5 参照設定追加

    Sub add_ref3()
        Workbooks(指定ブック).VBProject.References. _
             AddFromFile "c:\program files\common files\microsoft shared\dao\dao3032.dll"
    End Sub

演算子比較演算子

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub 比較演算子()

'****************************************************
'比較演算子サンプル
'****************************************************
Dim a As Long, b As Byte, c(6, 3) As String, d As Byte

a = 10: b = 3

For d = 1 To UBound(c, 1)
    c(d, 3) = False
Next d

c(1, 1) = "=":  c(1, 2) = "等しい":         If a = b Then c(1, 3) = True
c(2, 1) = "<>": c(2, 2) = "違う":           If a <> b Then c(2, 3) = True
c(3, 1) = "<":  c(3, 2) = "右より小さい":   If a < b Then c(3, 3) = True
c(4, 1) = "<=": c(4, 2) = "右より以下":     If a <= b Then c(4, 3) = True
c(5, 1) = ">":  c(5, 2) = "右より大きい":   If a > b Then c(5, 3) = True
c(6, 1) = ">=": c(6, 2) = "右より以上":     If a >= b Then c(6, 3) = True

For d = 1 To UBound(c, 1)
    MsgBox a & c(d, 1) & b & " = " & c(d, 3) & " です。", 0, "【" & c(d, 2) & "】"
Next d

End Sub

演算子数値演算に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'三角関数による値の取得 Atn, Cos, Sin, Tan
'一般的な計算 Exp, Log, Sqr
'乱数の発生 Randomize, Rnd
'絶対値の取得 Abs
'式の符号の取得 Sgn
'数値変換の実行 Fix, Int

演算子論理演算子

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub 論理演算子()

'****************************************************
'論理演算子サンプル
'****************************************************
Dim a As Long, b As Byte, c(3, 3) As String, d As Byte, e As Byte

a = 10: b = 10: e = 5

For d = 1 To UBound(c, 1)
    c(d, 3) = False
Next d

c(1, 1) = "And":    c(1, 2) = "全て一致":   If a = b And a = e Then c(1, 3) = True
c(2, 1) = "Or":     c(2, 2) = "何れか一致": If a = b Or a = e Then c(2, 3) = True
c(3, 1) = "Not":    c(3, 2) = "違えばOK":   If Not a = b Then c(3, 3) = True

For d = 1 To UBound(c, 1)
    MsgBox c(d, 1) & " = " & c(d, 3) & " です。", 0, "【" & c(d, 2) & "】"
Next d

End Sub

印刷印刷不可能にする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub Workbook_BeforePrint(Cancel As Boolean)
'*******************************************************************************
'印刷不可能にする
'*******************************************************************************
Dim tit As String, sty As Byte, str As String
Dim msg As Variant
    Cancel = True
    tit = "Not Print！"
    sty = vbExclamation
    str = "印刷出来ません"
    msg = MsgBox(str, sty, tit)
End Sub

印刷印刷が出来ないようにする。

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
End Sub

ループループ（For_Each_Next)の記述

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub AllSht()

'’アクティブブックの全てのシートに・・・

Dim Sht As Worksheet

For Each Sht In ActiveWorkbook.Worksheets

Sht.Range("A1").Value = 99

Next Sht

End Sub

Sub AllBok()

'’開いている全てのブックの全てのシートに・・・

Dim Bok As Workbook､, Sht As Worksheet

For Each Bok In Workbooks

For Each Sht In Bok.Worksheets

Sht.Range("A1").Value = 99

Next Sht

Next Bok

End Sub

ループループ連番オブジェクトをFor～Nextで使う

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

For byeFor(ForNo) = 1 To 22
Me("TextBox_" & byeFor(ForNo)).Value = shtTarget.Cells(Me.SpinButton1, byeFor(ForNo)).Value
Next byeFor(ForNo)
Exit Sub

演算子演算子キーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'算術演算子 ^, -, *, /, \, Mod, +, &, =
'比較演算子 =, <>, <, >, <=, >=, Like, Is
'論理演算子 Not, And, Or, Xor, Eqv, Imp

印刷幅と高さを1ページに収まるように印刷する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub 幅と高さを1ページに収まるように印刷する()
'*****************************
'幅と高さを1ページに収める
'*****************************
    With Worksheets("SSS").PageSetup
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
    End With
    ActiveSheet.PrintPreview                    '印刷（プリント）プレビュー
End Sub

演算子算術演算子

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub 算術演算子()

'****************************************************
'算術演算子サンプル
'****************************************************
Dim a As Long, b As Byte, c(7, 3) As String, d As Byte

a = 10: b = 3

c(1, 1) = "+":      c(1, 2) = "加算式":     c(1, 3) = a + b
c(2, 1) = "-":      c(2, 2) = "減算式":     c(2, 3) = a - b
c(3, 1) = "*":      c(3, 2) = "乗算式":     c(3, 3) = a * b
c(4, 1) = "/":      c(4, 2) = "除算式":     c(4, 3) = a / b
c(5, 1) = "\":      c(5, 2) = "除算商":     c(5, 3) = a \ b
c(6, 1) = "Mod":    c(6, 2) = "除算余":     c(6, 3) = a Mod b
c(7, 1) = "^":      c(7, 2) = "べき乗":     c(7, 3) = a ^ b

For d = 1 To UBound(c, 1)
    MsgBox a & c(d, 1) & b & " = " & c(d, 3) & " です。", 0, "【" & c(d, 2) & "】"
Next d

End Sub

情報関連 Property_Setステートメントオブジェクトへの参照を設定

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'Property プロシージャの名前、引数、およびプロシージャの本体を構成するコードを宣言します。Property Set プロシージャは、オブジェクトへの参照を設定します。
'
'構文
'
'[Public | Private | Friend] [Static] Property Set name ([arglist,] reference)
'[statements]
'[Exit Property]
'[statements]

'Property Set ステートメントの構文は、次の指定項目から構成されます。
'
'指定項目
'Optional
'Public
'Private
'Friend
'Static
'name
'arglist
'reference
'statements
'
'引数 arglist は、次の形式で指定します。
'
'[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
'
'指定項目
'Optional
'ByVal
'ByRef
'ParamArray
'varname
'type
'defaultvalue
'
'メモ Property Set ステートメントを使って定義する各プロシージャには、引数が少なくとも 1 つは必要です。この引数 (引数が 2 つ以上ある場合は一番最後の引数) には、Property Set ステートメントで定義されたプロシージャが呼び出されたときに、そのプロパティに対する実際のオブジェクト参照が設定されます。この引数は、上記の構文の引数 reference として参照されます。この引数にはキーワード Optional を指定できません。
'
'解説
'
'キーワード Public、Private、または Friend を用いて明示的に指定しない場合、Property プロシージャは、パブリックプロシージャになります。キーワード Static を指定しない場合、ローカル変数の値は、Property プロシージャの実行が終了すると破棄されます。キーワード Friend は、クラスモジュール内でのみ使えます。ただし、Friend を指定したプロシージャは、プロジェクト内のすべてのモジュールのプロシージャから呼び出せます。Friend を指定したプロシージャは、親クラスのタイプライブラリには書き込まれません。また、実行時バインディングは行えません
'
'実行可能なコードは、すべてプロシージャ内に記述する必要があります。また、Property Set プロシージャは、ほかの Property プロシージャ、Sub プロシージャ、Function プロシージャの中では定義できません。
'
'Exit Property ステートメントは、Property Set プロシージャを直ちに終了させます。プログラムの実行は、その Property Set プロシージャを呼び出したステートメントの次のステートメントから続行されます。Exit Property ステートメントは、Property Set プロシージャ内の任意の場所に、必要に応じていくつでも記述できます。
'
'Function プロシージャおよび Property Get プロシージャと同様に、Property Set プロシージャは、引数を受け取り、一連のステートメントを実行して、引数の値を変更できる独立したプロシージャです。ただし、値を返す Function プロシージャまたは Property Get プロシージャとは異なり、Property Get プロシージャは値を返さないため、オブジェクトへの参照を代入するステートメント (Set ステートメント) の左辺にしか記述できません。
'
'Property Set ステートメントの使用例
'
'次の例では、Property Set ステートメントを使って、オブジェクトへの参照を設定する Property プロシージャを宣言します。

' Pen プロパティに、別のペンのインプリメントを設定します。
Property Set Pen(P As Object)
Set CurrentPen = P ' Pen をオブジェクトに代入します。
End Property

情報関連 Property_Getステートメントプロパティの値を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'Property プロシージャの名前、引数、および Property プロシージャの本体を構成するコードを宣言します。Property プロシージャを使ってプロパティの値を取得します。
'
'構文
'
'[Public | Private | Friend] [Static] Property Get name [(arglist)] [As type]
'[Statements]
'[name = expression]
'[Exit Property]
'[Statements]
'[name = expression]

'Property Get ステートメントの構文は､次の指定項目から構成されます｡
'
'指定項目
'Public
'Private
'Friend
'Static
'name
'arglist
'Type
'
'
'Statements
'expression
'
'引数 arglist は、次の形式で指定します。
'
'[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
'
'指定項目
'Optional
'ByVal
'ByRef
'ParamArray
'varname
'type
'defaultvalue
'
'解説
'
'キーワード Public、Private、または Friend を指定しない場合、Property プロシージャは、既定のパブリックプロシージャになります。キーワード Static を指定しない場合、ローカル変数の値は、Property プロシージャの実行が終了すると破棄されます。キーワード Friend は、クラスモジュール内でのみ使えます。ただし、Friend を指定したプロシージャは、プロジェクト内のすべてのモジュールのプロシージャから呼び出せます。Friend を指定したプロシージャは、親クラスのタイプライブラリには書き込まれません。また、実行時バインディングは行えません。
'
'実行可能なコードは、すべてプロシージャ内に記述する必要があります。また、Property Get プロシージャをほかの Property プロシージャ、Sub プロシージャ、Function プロシージャの中で定義することはできません。
'
'Exit Property ステートメントは、Property Get プロシージャを直ちに終了させます。プログラムの実行は、その Property Get プロシージャを呼び出したステートメントの次のステートメントから続行されます。Exit Property ステートメントは、Property Get プロシージャ内の任意の場所に、必要に応じていくつでも記述できます。
'
'Sub プロシージャおよび Property Let プロシージャと同様に、Property Get プロシージャは、引数を受け取り、一連のステートメントを実行して、引数の値を変更できる独立したプロシージャです。ただし、Sub プロシージャまたは Property Let プロシージャとは異なり、Property Get プロシージャは、プロパティの値を返す必要がある場合、Function プロシージャやプロパティ名と同じように式の右辺に記述できます。
'
'Property Get ステートメントの使用例()
'
'次の例では、Property Get ステートメントを使って、プロパティの値を取得するための Property プロシージャを定義します。このプロパティは、現在のペンの色を文字列で示します。

Dim CurrentColor As Integer
Const BLACK = 0, RED = 1, GREEN = 2, BLUE = 3

' 現在のペンの色を示す文字列を返します。
Property Get PenColor() As String
    Select Case CurrentColor
        Case RED
            PenColor = "Red"
        Case GREEN
            PenColor = "Green"
        Case BLUE
            PenColor = "Blue"
    End Select
End Property

' 次のコードでは、Property Get プロシージャを呼び出して、
' ペンの色を取得しています。
ColorName = PenColor

情報関連 Property_Letステートメントプロパティに値を設定

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'Property Let プロシージャの名前、引数、およびプロシージャの本体を構成するコードを宣言します。Property Let プロシージャは、プロパティに値を設定します。
'
'構文
'
'[Public | Private | Friend] [Static] Property Let name ([arglist,] value)
'[statements]
'[Exit Property]
'[statements]

'Property Let ステートメントの構文は、次の指定項目から構成されます。
'
'指定項目
'Public
'Private
'Friend
'Static
'name
'arglist
'Value
'statements
'
'引数 arglist は、次の形式で指定します。
'
'[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
'
'指定項目
'Optional
'ByVal
'ByRef
'ParamArray
'varname
'type
'defaultvalue
'
'メモ Property Let ステートメントを使って定義するプロシージャには、引数が少なくとも 1 つは必要です。この引数 (引数が 2 つ以上ある場合は一番最後の引数) には、Property Let ステートメントによって定義されるプロシージャが呼び出されたときに、プロパティに設定される実際の値が設定されます。この引数は、上記の構文の引数 value として参照されます。
'
'解説
'
'キーワード Public、Private、または Friend を用いて明示的に指定しない場合、Property プロシージャは、パブリックプロシージャになります。キーワード Static を指定しない場合、ローカル変数の値は、Property プロシージャの実行が終了すると破棄されます。キーワード Friend は、クラスモジュール内でのみ使えます。ただし、Friend を指定したプロシージャは、プロジェクト内のすべてのモジュールのプロシージャから呼び出せます。Friend を指定したプロシージャは、親クラスのタイプライブラリには書き込まれません。また、実行時バインディングは行えません。
'
'実行可能なコードは、すべてプロシージャ内に記述する必要があります。また、Property Let プロシージャは、ほかの Property プロシージャ、Sub プロシージャ、Function プロシージャの中では定義できません。
'
'Exit Property ステートメントは、Property Let プロシージャを直ちに終了させます。プログラムの実行は、その Property Let プロシージャを呼び出したステートメントの次のステートメントから続行されます。Exit Property ステートメントは、Property Let プロシージャ内の任意の場所に、必要に応じていくつでも記述できます。
'
'Function プロシージャおよび Property Get プロシージャと同様に、Property Let プロシージャは、引数を受け取り、一連のステートメントを実行して、引数の値を変更できる独立したプロシージャです。ただし、値を返す Function プロシージャまたは Property Get プロシージャとは異なり、Property Get プロシージャは値を返さないため、プロパティの値を設定する式または Let ステートメントの左辺にしか記述できません。
'
'Property Let ステートメントの使用例
'
'次の例では、Property Let ステートメントを使って、プロパティに値を代入するプロシージャを定義します。プロパティの値は描画パッケージのペンの色を示します。

Dim CurrentColor As Integer
Const BLACK = 0, RED = 1, GREEN = 2, BLUE = 3

' 描画パッケージのペン色を指定するプロパティを設定します。
' モジュールレベル変数 CurrentColor には、
' 描画に用いられる色を指定する数値が設定されます。
Property Let PenColor(ColorName As String)
    Select Case ColorName        ' 色の名前を調べます。
        Case "Red"
            CurrentColor = RED    ' 赤に対応する値を代入します。
        Case "Green"
            CurrentColor = GREEN    ' 緑に対応する値を代入します。
        Case "Blue"
            CurrentColor = BLUE    ' 青に対応する値を代入します。
        Case Else
            CurrentColor = BLACK    ' 既定値を代入します。
    End Select
End Property

' 次のコードでは、Property Let プロシージャを呼び出して
' 描画パッケージの PenColor プロパティの値を設定します。

PenColor = "Red"

参照設定追加されている参照設定を解除(一覧より指定)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub RefRemoveChoice()
'*****************************
'追加されている参照設定を解除
'*****************************
'解除する参照設定を選択する場合

Dim objBok As Workbook
Dim objReferences As Object
Dim strRefName As String
Dim strRefDscrp As String
Dim strMSG(2) As String

strMSG(2) = "[はい] 解除 / [いいえ] 維持"

Set objBok = ThisWorkbook

With objBok.VBProject
    For Each objReferences In objBok.VBProject.References
        strRefName = objReferences.Name
        strRefDscrp = objReferences.Description
        strMSG(1) = strRefName & "[ " & strRefDscrp & " ]"

        If MsgBox(strMSG(1) & vbCrLf & vbCrLf & strMSG(2), vbInformation + vbYesNo, "参照設定解除") = vbYes Then

            .References.Remove objReferences

        End If
    Next objReferences
End With

End Sub

参照設定追加されている参照設定を解除(Library指定)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub RefRemove()
'*****************************
'追加されている参照設定を解除
'*****************************
'解除する参照設定が判明している場合

Dim objBok As Workbook
Dim objReferences As Object
Dim strFoundName As String

strFoundName = "Microsoft DAO 3.6 Object Library"

Set objBok = ThisWorkbook

'既に解除されててもエラーは発生しません。
'存在しないLibraryを指定してもエラーは発生しません。
On Error GoTo ONERR:

With objBok.VBProject
    For Each objReferences In objBok.VBProject.References
        If objReferences.Description = strFoundName Then
            .References.Remove objReferences
        End If
    Next objReferences
End With
Exit Sub

ONERR:

    MsgBox Err.Number & vbTab & Err.Description, vbCritical, "参照設定Error!"

End Sub

情報関連 EXCELBOOKドキュメントプロパティの取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の表は、組み込みのドキュメントプロパティの ID 番号と名前の一覧です。
'
'ID 番号名前    ローカル名
'1   Title タイトル
'
'2   Subject サブタイトル
'
'3   Author 作成者
'
'4   Keywords キーワード
'
'5   Comments コメント
'
'6   Template テンプレート
'
'7   Last Author 更新者
'
'8   Revision Number 改訂番号
'
'9   Application Name    アプリケーション名
'
'10  Last Print Date 印刷日時
'
'11  Creation Date   作成日時
'
'12  Last Save Time  更新日時
'
'13  Total Editing Time  編集時間
'
'14  Number of Pages ページ数
'
'15  Number of Words 単語数
'
'16  Number of Characters    文字数
'
'17  Security セキュリティ
'
'18  Category 分類
'
'19  Format 形式
'
'20  Manager 管理者
'
'21  Company 会社名
'
'22  Number of Bytes バイト数
'
'23  Number of Lines 行数
'
'24  Number of Paragraphs    段落数
'
'25  Number of Slides    スライドの数
'
'26  Number of Notes メモの数
'
'27  Number of Hidden Slides 非表示スライドの数
'
'28  Number of Multimedia Clips  マルチメディアクリップの数
'
'29  Hyperlink base  ハイパーリンクの基点
'
'30  Number of Charactors (with space)   文字数 (スペースを含む)
'
'コンテナアプリケーションでは、すべての組み込みのドキュメントプロパティに対して値が定義されているわけではありません。
'目的のアプリケーションで組み込みのドキュメントプロパティの値が定義されていない場合､
'そのドキュメントプロパティに対する Value プロパティを取得すると、エラーが発生します。

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

'BuiltinDocumentProperties プロパティの使用例
'
'次の使用例は、組み込みのドキュメントプロパティの名前のリストを、ワークシート 1 に作成します。
Dim rw, p, a
rw = 1
Worksheets(1).Activate
For Each p In ActiveWorkbook.BuiltinDocumentProperties
    Cells(rw, 1).Value = p.Name
    rw = rw + 1
Next

For a = 1 To rw - 1
On Error Resume Next
p = Me.BuiltinDocumentProperties(Cells(a, 1).Value)
Cells(a, 2).Value = p
EE:
Next a
End Sub

情報関連 MemoryTotalプロパティ使用可能なメモリの容量

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の使用例は､空き容量をバイト単位で示すメッセージを表示します｡

MsgBox "メモリの空き容量は " & Application.MemoryFree & " バイトです。"

'次の使用例は､使用できるバイト単位の全容量を示すメッセージを表示します｡

MsgBox "使用可能なメモリの容量は " & Application.MemoryTotal & _
" バイトです。"

情報関連システム起動後の経過時間を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub TimeAfterSystemStart()
'************************************
'システム起動後の経過時間を取得する
'************************************
'ミリ秒=1,000分の1秒
Dim dbl_Second As Double

dbl_Second = GetTickCount / 1000

MsgBox "起動から[ " & dbl_Second & " ]秒経過しました。"

End Sub

プラットフォーム SDK

GetTickCount

システムを起動した後の経過時間を、ミリ秒（ms）単位で取得します。この時間は、システムタイマの分解能による制限を受けます。システムタイマの分解能を取得するには、GetSystemTimeAdjustment 関数を使います。
DWORD GetTickCount(VOID);
- パラメータ
- パラメータはありません。
戻り値
- 関数が成功すると、システムを起動した後の経過時間が、ミリ秒単位で返ります。
解説
- 経過時間は DWORD 型で保存されています。システムを 49.7 日間連続して動作させると、経過時間は 0 に戻ります。
- より高い分解能のタイマが必要な場合は、「」（マルチメディアタイマ）または「」（高分解能タイマ）を使います。
- Windows NT/2000：コンピュータを起動した後の経過時間を取得するには、レジストリの HKEY_PERFORMANCE_DATA キー内の System Up Time カウンタを取得します。この値は、8 バイトです。詳細については、MSDN ライブラリの「」を参照してください。

情報関連 VarType関数変数の内部処理形式を調べます

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'コピペ用VBE用に空白スペース

'変数の内部処理形式を表す整数型 (Integer) の値を返します。
'
'構文
'
'VarType (varname)
'
'引数 varname は必ず指定します。引数 varname には、ユーザー定義型の変数を除く、
'任意のバリアント型 (Variant) の変数を指定します。

'戻り値
'
'定数              値     内容
'vbEmpty            0     Empty 値 (未初期化)
'vbNull             1     Null 値 (無効な値)
'vbInteger          2     整数型 (Integer)
'vbLong             3     長整数型 (Long)
'vbSingle           4     単精度浮動小数点数型 (Single)
'vbDouble           5     倍精度浮動小数点数型 (Double)
'vbCurrency         6     通貨型 (Currency)
'vbDate             7     日付型 (Date)
'vbString           8     文字列型 (String)
'vbObject           9     オブジェクト
'vbError           10     エラー値
'vbBoolean         11     ブール型 (Boolean)
'vbVariant         12     バリアント型 (Variant) (バリアント型配列にのみ使用)
'vbDataObject      13     非OLE オートメーションオブジェクト
'vbDecimal         14     10 進数型
'vbByte            17     バイト型 (Byte)
'vbUserDefinedType 36     ユーザー定義型を含むバリアント型
'vbArray         8192     配列
'
'
'メモこれらの定数は、Visual Basic で定義されているものです。
'コードの中の任意の場所で､実際の値の代わりに使用できます｡
'
'解説
'
'VarType 関数は、定数 vbArray の値 (8192) を単独では返しません。
'この値は常にデータ型を表す他の値と加算されて返され､
'指定した変数がそのデータ型の要素を持つ配列であることを示します｡
'定数 vbVariant は、常に定数 vbArray と加算されて返され、
'指定した変数がバリアント型の配列であることを示します｡
'たとえば､整数型の要素を持つ配列を指定したときは､
'vbInteger + vbArray として計算された値 8194 が返されます。
'オブジェクトが既定プロパティを持つとき､
'VarType (object) はその既定プロパティの型を返します。
'
'
'VarType 関数の使用例
'
'次の例は､VarType 関数を使って､変数の内部処理形式を調べます｡

Dim IntVar, StrVar, DateVar, MyCheck
' 変数を初期化します。
IntVar = 459: StrVar = "こんにちは": DateVar = #2/12/1969#
MyCheck = VarType(IntVar)            ' 2 を返します。
MyCheck = VarType(DateVar)        ' 7 を返します。
MyCheck = VarType(StrVar)            ' 8 を返します。

情報関連エクセルアプリケーションのコマンドバー(メニュー)を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Dim j As Long
Dim sht As Worksheet

Private Sub CommandBarGet()
'*************************************************
'エクセルアプリケーションのコマンドバーを取得する
'*************************************************
'メニューを取得する

Dim i As Long, Bar As CommandBar
    For Each Bar In Application.CommandBars
        i = i + 1
        Debug.Print i & " - " & Bar.Name
    Next
End Sub

Private Sub CommandBarControlGet()
'*************************************************
'エクセルアプリケーションのコマンドバーを取得する
'*************************************************
'メニューを取得する

Dim i As Long, Bar As CommandBarControl
Dim objCommandBar As CommandBar
Set objCommandBar = Application.CommandBars("Worksheet Menu Bar")
    For Each Bar In objCommandBar.Controls
        i = i + 1
        Debug.Print i & " - " & Bar.Caption
    Next
End Sub

Private Sub CommandBarControlMenuGet()
'*************************************************
'エクセルアプリケーションのコマンドバーを取得する
'*************************************************
'メニューを取得する

Dim i As Long, Bar As CommandBarControl
Dim objCommandBar As CommandBar
Set objCommandBar = Application.CommandBars("Worksheet Menu Bar")
Dim objCommandBarPopup As CommandBarPopup
Set objCommandBarPopup = objCommandBar.Controls("ファイル(&F)")
    For Each Bar In objCommandBarPopup.Controls
        i = i + 1
        Debug.Print i & " - " & Bar.Caption
    Next
End Sub

Private Sub CommandBarControlSubMenuGet()
'*************************************************
'エクセルアプリケーションのコマンドバーを取得する
'*************************************************
'メニューを取得する

Dim i As Long, Bar As CommandBarControl
Dim objCommandBar As CommandBar
Set objCommandBar = Application.CommandBars("Worksheet Menu Bar")
Dim objCommandBarPopup As CommandBarPopup
Set objCommandBarPopup = objCommandBar.Controls("ファイル(&F)")
Dim objCommandBarControl As CommandBarControl
Set objCommandBarControl = objCommandBarPopup.Controls("送信(&D)")
    For Each Bar In objCommandBarControl.Controls
        i = i + 1
        Debug.Print i & " - " & Bar.Caption
    Next
End Sub

'===========================================================================

Private Sub aCommandBarGet()
'*********************************************************
'全てのエクセルアプリケーションのコマンドバーを取得する
'*********************************************************
'メニューを取得する
j = 0
Set sht = ThisWorkbook.Worksheets.Add
Dim i As Long, Bar As CommandBar
    For Each Bar In Application.CommandBars
        j = j + 1
        i = i + 1
        sht.Cells(j, 1).Value = Format(i, "0#") & "." & Bar.Name
        aCommandBarControlGet Bar.Name
    Next
End Sub

Private Sub aCommandBarControlGet(str1 As String)
'*************************************************
'エクセルアプリケーションのコマンドバーを取得する
'*************************************************
'メニューを取得する

Dim i As Long, Bar As CommandBarControl
Dim objCommandBar As CommandBar
Set objCommandBar = Application.CommandBars(str1)
    For Each Bar In objCommandBar.Controls
        j = j + 1
        i = i + 1
        sht.Cells(j, 1).Value = "　　├" & Format(i, "0#") & "." & Bar.Caption
        aCommandBarControlMenuGet str1, Bar.Caption
    Next
End Sub

Private Sub aCommandBarControlMenuGet(str1 As String, str2 As String)
'*************************************************
'エクセルアプリケーションのコマンドバーを取得する
'*************************************************
'メニューを取得する

Dim i As Long, Bar As CommandBarControl
Dim objCommandBar As CommandBar
On Error GoTo TheEnd:
Set objCommandBar = Application.CommandBars(str1)
Dim objCommandBarPopup As CommandBarPopup
Set objCommandBarPopup = objCommandBar.Controls(str2)
    For Each Bar In objCommandBarPopup.Controls
        j = j + 1
        i = i + 1
        sht.Cells(j, 1).Value = "　　　　├" & Format(i, "0#") & "." & Bar.Caption
        aCommandBarControlSubMenuGet str1, str2, Bar.Caption
    Next
TheEnd:
End Sub

Private Sub aCommandBarControlSubMenuGet(str1 As String, str2 As String, str3 As String)
'*************************************************
'エクセルアプリケーションのコマンドバーを取得する
'*************************************************
'メニューを取得する

Dim i As Long, Bar As CommandBarControl
Dim objCommandBar As CommandBar
On Error GoTo TheEnd:
Set objCommandBar = Application.CommandBars(str1)
Dim objCommandBarPopup As CommandBarPopup
Set objCommandBarPopup = objCommandBar.Controls(str2)
Dim objCommandBarControl As CommandBarControl
Set objCommandBarControl = objCommandBarPopup.Controls(str3)
    For Each Bar In objCommandBarControl.Controls
        j = j + 1
        i = i + 1
        sht.Cells(j, 1).Value = "　　　　　　├" & Format(i, "0#") & "." & Bar.Caption
    Next
TheEnd:
End Sub

情報関連プロダクトＩＤを取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MsgBox CreateObject("WScript.Shell").RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\User information\Product Identification")

情報関連ドライブが存在するか

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Function DriveUmu(str As String) As Boolean
'*******************************************************************************
'ドライブが存在するか
'*******************************************************************************
    Dim a As String
    Dim Fso
    a = Left(str, 1)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Fso.DriveExists(a) Then
        DriveUmu = True ' ドライブが存在します"
    Else
        DriveUmu = False 'ドライブは存在しません"
    End If
End Function

情報関連指定フォルダ内のJPGファイル横幅ピクセルを取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub GetFileWidthPixelInFolder()
'*******************************************************
'指定フォルダ内のJPGファイル横幅ピクセルを取得
'*******************************************************
'JPGやMP3ファイルのプロパティを取得

Dim objCRT As Object, objFldr As Object, i As Byte
Dim strPrprty(34) As String 'ファイル情報の項目名をセット
Dim strFlNm As Object, str As String, folPath As String
Dim Spl As Variant

folPath = ThisWorkbook.Path & "\" & "Windows_MediaPlayer"

'ActiveX オブジェクトへの参照
Set objCRT = CreateObject("Shell.Application")
'名前空間の名前を宣言
Set objFldr = objCRT.Namespace("" & folPath & "")

For i = 0 To 33
    'ファイル情報の項目名をセット(取得).Items
    '[GetDetailsOf]ファイル情報を取得(ファイル名.Items,情報番号)
    strPrprty(i) = objFldr.GetDetailsOf(objFldr.Items, i)
Next

For Each strFlNm In objFldr.Items
    If Right(strFlNm, 4) = ".jpg" Then
    str = "" 'クリア
    i = 27 '横ピクセル
'    i = 28 '縦ピクセル
        str = objFldr.GetDetailsOf(strFlNm, i)
        '[GetDetailsOf]ファイル情報を取得(ファイル名,情報番号)
    Spl = Split(str)
    MsgBox strFlNm & vbTab & Spl(0)
    End If
Next

'--------------------------------------------------

'【JPG表示項目一覧】
'0   名前    1.jpg
'1   サイズ  9 KB
'2   種類    JPEG イメージ
'3   更新日時    2008/04/11 17:14
'4   作成日時    2009/10/14 14:20
'5   アクセス日時    2009/10/14 16:12
'6   属性
'7   状態
'8   所有者 --------
'9   作成者
'10  タイトル
'11  表題
'12  カテゴリ
'13  ページ数
'14  コメント
'15  著作権
'16  アーティスト
'17  アルバムのタイトル
'18  年
'19  トラック番号
'20  ジャンル
'21  長さ
'22  ビットレート
'23  保護
'24  カメラのモデル
'25  写真の撮影日
'26  大きさ  282 x 100
'27      282 ピクセル
'28      100 ピクセル
'29  この回のタイトル
'30  プログラムの説明
'31
'32  オーディオサンプルサイズ
'33  オーディオサンプルレート

'--------------------------------------------------

'【MP3表示項目一覧】
'0   名前    02 Even the Nights Are Better.mp3
'1   サイズ  4,525 KB
'2   種類    MP3 形式サウンド
'3   更新日時    2009/04/07 8:19
'4   作成日時    2008/09/08 8:21
'5   アクセス日時    2009/10/14 16:24
'6   属性 a
'7   状態オンライン
'8   所有者 --------
'9   作成者  Air Supply
'10  タイトル    Even the Nights Are Better
'11  表題
'12  カテゴリ Rock
'13  ページ数
'14  コメント
'15  著作権
'16  アーティスト    Air Supply
'17  アルバムのタイトル Now And Forever
'18  年 1982
'19  トラック番号 2
'20  ジャンル Rock
'21  長さ    0:03:58
'22  ビットレート   192kbps
'23  保護いいえ
'24  カメラのモデル
'25  写真の撮影日
'26  大きさ
'27
'28
'29  この回のタイトル
'30  プログラムの説明
'31
'32  オーディオサンプルサイズ  0 ビット
'33  オーディオサンプルレート  44 KHz

End Sub

特殊・他 LZHファイルの解凍

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'LZHファイルの解凍

'○UnLHA32.DLL（著作micco氏フリーウェア）DLサイト http://www2.nsknet.or.jp/~micco/micindex.html

'○OS・マシン環境によりパスは異なります。＜例＞「c:\windows\system」又は「C:\WINNT\system32」等内に上記の「UnLHA32.DLL」をコピー

'↓Declare Function（Private宣言にて下記SUBステートメントも同モジュール内に記述又はコピー）

'UNLHA32.DLLのUnlha関数使用宣言
Private Declare Function Unlha Lib "UNLHA32.DLL" (ByVal Callhwnd As Long, ByVal LHACommand As String, ByVal RetBuff As String, ByVal RetBuffSize As Long) As Long

'サブルーチン
Sub LZHファイルを解凍(KaitoSakiPath As String, KaitoMotoPath As String, Msg As Boolean)
'*引数Msgが「False」の場合解凍成功後そのLZHファイルを削除

Dim スペース文字対策 As String, 解凍先パス As String, 解凍LZHファイルパス As String
Dim パラメータ As String, 戻値 As Long, スイッチ As String
Dim UNLHA結果バッファ As String * 255 '（255バイトまで）

スペース文字対策 = """" 'Documents and Settings\のようにスペースがある場合、パラメータ用に誤認識対策
スイッチ = "e" '各スイッチの詳細はmicco氏作成COMMAND.TXTを参照

解凍先パス = スペース文字対策 & KaitoSakiPath & "\" & スペース文字対策

解凍LZHファイルパス = スペース文字対策 & KaitoMotoPath & スペース文字対策

パラメータ = スイッチ & " " & 解凍LZHファイルパス & " " & 解凍先パス

戻値 = Unlha(0, パラメータ, UNLHA結果バッファ, 255)

If Msg = True Then
    If 戻値 = 0 Then MsgBox (UNLHA結果バッファ)
Else
    If 戻値 = 0 Then Kill KaitoMotoPath
End If

End Sub

Sub test()
LZHファイルを解凍 ThisWorkbook.Path, ThisWorkbook.Path & "\" & "*.lzh", True
End Sub

特殊・他 CSSのIDとClass名をHtmlと同時に変更する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit
'***********************************************
'CSSのIDとClass名をHtmlと同時に変更する
'***********************************************
'CSSは１行づつ並んでいることが条件です。
'http://www.akiyan.com/css_beautifier
'↑オンラインで無料で整形可能です(スペースが必要)
'先にHTMLの方からIDとClassを探します。
'動作確認済ですがバックアップをとってから実行願います。
'同階層に[変換元][変換先]フォルダが必要です。
'[変換元]フォルダに変更するそれぞれのファイルを入れて実行。

Dim shtDdata As Worksheet

Sub 開始1()
'***********************************************
'フォルダ内の全てのファイル取得
'***********************************************

Dim buf As String, tgtPath As String, sbuf As String
Dim strExtension As String, OutPath As String
Dim TargetFile As String, n As Long
Dim sampleName As String

strExtension = "*.htm*" '拡張子指定

Set shtDdata = ThisWorkbook.Worksheets("Data")
shtDdata.Cells.ClearContents
    shtDdata.Cells(1, 1).Value = "HTMLID"
    shtDdata.Cells(1, 2).Value = "→"
    shtDdata.Cells(1, 3).Value = "変更"

    shtDdata.Cells(1, 5).Value = "HTMLClass"
    shtDdata.Cells(1, 6).Value = "→"
    shtDdata.Cells(1, 7).Value = "変更"

    shtDdata.Cells(1, 9).Value = "【説明】"
    shtDdata.Cells(2, 9).Value = "・変更不要な場合は空白のまま。"
    shtDdata.Cells(3, 9).Value = "・id=""aaa""のaaa部分のみ入力"
    shtDdata.Cells(4, 9).Value = "・一目で変更したと判るような変更が良い"

tgtPath = ThisWorkbook.Path & "\変換元"
OutPath = ThisWorkbook.Path & "\変換先"

DeleteFile OutPath & "\", strExtension

sbuf = Dir(tgtPath & "\" & strExtension)
Do While sbuf <> ""
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    TargetFile = tgtPath & "\" & sbuf
    buf = Space(FileLen(TargetFile))
    Open TargetFile For Binary As #n 'binaryモードで開いたファイル
        Get #n, , buf 'からデータを読み込むにはGetステートメントを使う
    Close #n

    SearchAllLettersBetween buf, " id=", """", 1
    SearchAllLettersBetween buf, " class=", """", 5
    sbuf = Dir()
Loop

sampleName = InputBox("ここでサンプル改変名で入力できます。※英字小文字で入力" _
& vbCr & vbCr & "※全て実行されます。", "サンプル", "sample")
If sampleName <> "" Then
    SampleMaking sampleName
    開始2
Else
MsgBox "シート" & shtDdata.Name & "を参照し変更後、[開始2]を行って下さい。"
End If

End Sub

Private Sub SearchAllLettersBetween(str As String, strFoundFront As String, strFoundBack As String, lngCol As Long)
'************************************************
'文字中の指定文字と指定文字間の文字を全て検索
'************************************************
'引数strは対象文字群
'引数strFoundFrontは前方検索対象文字
'引数strFoundBackは後方検索対象文字

'＜例＞
'str = "zyzyzyzabc="def"zyzyzyzabc="ghij"zyz"
'strFoundFront = "abc="
'strFoundBack = """"
'返値は [abc="def"] と[abc="ghij"]　になります。

'＜解説＞
'Replace関数で一度検索したものは全て消すところがミソ！
'検索文字がなくなるまで実行します。
'書き出したい場合は[Debug.Print Xa]の個所を改変してください。

Dim i As Long, Xa As String, Xb As Long, j As Long

reTRY: '再帰①
i = InStr(1, str, strFoundFront) '前方検索対象文字位置
If i = 0 Then GoTo TheEnd: '無ければ終了②
Xb = InStr(i + Len(strFoundFront) + 1, str, strFoundBack) '後方検索対象文字位置
Xa = Mid(str, i, Xb - i + 1) '値をゲット
Debug.Print Xa
j = shtDdata.Cells(65536, lngCol).End(xlUp).Row + 1
shtDdata.Cells(j, lngCol).Value = Xa
shtDdata.Cells(j, lngCol + 1).Value = "→"
str = Replace(str, Xa, "") 'ゲット後は削除する(対象文字群内全て)

GoTo reTRY: '再帰①
TheEnd: '無ければ終了②
End Sub

Sub 開始2()
'***********************************************
'フォルダ内の全てのファイル取得
'***********************************************

Dim buf As String, tgtPath As String, sbuf As String
Dim strExtension As String, OutPath As String
Dim TargetFile As String, n As Long
Dim strExtension2 As String
Dim i As Long, vrnCSS As Variant, vrnCSS2 As Variant, vrnCSS3 As Variant
Dim strA As String, lngCSS As Long

Set shtDdata = ThisWorkbook.Worksheets("Data")

tgtPath = ThisWorkbook.Path & "\変換元"
OutPath = ThisWorkbook.Path & "\変換先"

DeleteFile OutPath & "\", strExtension

strExtension = "*.htm*" '拡張子指定
strExtension2 = "*.css" '拡張子指定

'===================================================================================
'【HTML】
sbuf = Dir(tgtPath & "\" & strExtension)
Do While sbuf <> ""
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    TargetFile = tgtPath & "\" & sbuf
    buf = Space(FileLen(TargetFile))
    Open TargetFile For Binary As #n 'binaryモードで開いたファイル
        Get #n, , buf 'からデータを読み込むにはGetステートメントを使う
    Close #n
    strA = buf
    With shtDdata
        For i = 1 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 3).Value <> "" Then
                If InStr(1, .Cells(i, 1).Value, "=") <> 0 Then
                   strA = Replace(strA, Trim(.Cells(i, 1).Value), "id=""" & Trim(.Cells(i, 3).Value) & """")
                End If
            End If
        Next i

        For i = 1 To .Cells(65536, 5).End(xlUp).Row
            If .Cells(i, 7).Value <> "" Then
                If InStr(1, .Cells(i, 5).Value, "=") <> 0 Then
                   strA = Replace(strA, Trim(.Cells(i, 5).Value), "class=""" & Trim(.Cells(i, 7).Value) & """")
                End If
            End If
        Next i
        pbsTxtWrites TargetFile, strA
    End With

    sbuf = Dir()
Loop
'===================================================================================
'【CSS】
sbuf = Dir(tgtPath & "\" & strExtension2)
Do While sbuf <> ""
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    TargetFile = tgtPath & "\" & sbuf
    buf = Space(FileLen(TargetFile))
    Open TargetFile For Binary As #n 'binaryモードで開いたファイル
        Get #n, , buf 'からデータを読み込むにはGetステートメントを使う
    Close #n
    strA = buf
    With shtDdata
        For i = 1 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 3).Value <> "" Then
                If InStr(1, .Cells(i, 1).Value, "=") <> 0 Then
                    vrnCSS = Split(Trim(.Cells(i, 1).Value), """")
                    strA = Replace(strA, "#" & Trim(vrnCSS(1)) & " ", "#" & Trim(.Cells(i, 3).Value) & " ")
                End If
            End If
        Next i

        For i = 1 To .Cells(65536, 5).End(xlUp).Row
            If .Cells(i, 7).Value <> "" Then
                If InStr(1, .Cells(i, 5).Value, "=") <> 0 Then
                    vrnCSS = Split(Trim(.Cells(i, 5).Value), """")
                    '複数要素設定の場合
                    vrnCSS2 = Split(Trim(vrnCSS(1))) '原文字
                    vrnCSS3 = Split(Trim(.Cells(i, 7).Value)) '変更文字
                    For lngCSS = LBound(vrnCSS2) To UBound(vrnCSS2)
                        strA = Replace(strA, "." & Trim(vrnCSS2(lngCSS)) & " ", "." & Trim(vrnCSS3(lngCSS)) & " ")
                    Next lngCSS
                End If
            End If
        Next i
        pbsTxtWrites TargetFile, strA
    End With

    sbuf = Dir()
Loop
'===================================================================================

MsgBox "完了"

tgtPath = ThisWorkbook.Path & "\変換元"
OutPath = ThisWorkbook.Path & "\変換先"

Name tgtPath As ThisWorkbook.Path & "\変換元A"
Name OutPath As ThisWorkbook.Path & "\変換先A"

Name ThisWorkbook.Path & "\変換元A" As ThisWorkbook.Path & "\変換先"
Name ThisWorkbook.Path & "\変換先A" As ThisWorkbook.Path & "\変換元"

End Sub

Private Sub pbsTxtWrites(TxtPath As String, str As String)
'*******************************************************************************
'指定パスのテキストファイルに書き込み
'*******************************************************************************
    Dim n As Long
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    Open TxtPath For Output As #n
        Print #n, str
    Close #n

' キーワード処理             モード
' Input   読み込み           入力モード
' Output  書き込み           出力モード
' Append  書き込み           追加モード
' Random  読み込み/書き込み  ランダムアクセスモード(データベースのデータファイルにアクセスするモード)
' Binary  読み込み/書き込み  バイナリモード(ファイルのデータを一気に読み込む)

End Sub

Private Sub DeleteFile(strPath As String, strFileName As String)
'**************************************
'ファイルを削除　引数指定
'パスの最後に[\]を付けない
'**************************************

On Error Resume Next

Kill strPath & "\" & strFileName

On Error GoTo 0

End Sub

Private Sub SampleMaking(str As String)
Dim shtDdata As Worksheet, i As Long, vrnCSS As Variant, vrnCSS2 As Variant
Dim lngCSS As Long, smName() As String, cntName As Long, blnName As Boolean
Dim mkName As String
ReDim smName(cntName) As String
Set shtDdata = ThisWorkbook.Worksheets("Data")
    With shtDdata
        For i = 1 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 3).Value = "" Then
                If InStr(1, .Cells(i, 1).Value, "=") <> 0 Then
                   .Cells(i, 3).Value = "id_" & str & "_" & i - 1
                End If
            End If
        Next i

        For i = 1 To .Cells(65536, 5).End(xlUp).Row
            If .Cells(i, 7).Value = "" Then
                If InStr(1, .Cells(i, 5).Value, "=") <> 0 Then
                    vrnCSS = Split(Trim(.Cells(i, 5).Value), """")
                    '複数要素設定の場合
                    vrnCSS2 = Split(Trim(vrnCSS(1)))
                    For lngCSS = LBound(vrnCSS2) To UBound(vrnCSS2)
                        '既にあるかチェック
                        blnName = False
                        For cntName = LBound(smName) To UBound(smName)
                            If smName(cntName) = vrnCSS2(lngCSS) Then
                                blnName = True
                                Exit For
                            End If
                        Next cntName
                        If blnName = False Then
                            ReDim Preserve smName(cntName)
                            smName(cntName) = vrnCSS2(lngCSS)
                            cntName = cntName + 1
                        End If
                    Next lngCSS
                End If
            End If
        Next i

        For i = 1 To .Cells(65536, 5).End(xlUp).Row
            If .Cells(i, 7).Value = "" Then
                If InStr(1, .Cells(i, 5).Value, "=") <> 0 Then
                    vrnCSS = Split(Trim(.Cells(i, 5).Value), """")
                    '複数要素設定の場合
                    vrnCSS2 = Split(Trim(vrnCSS(1)))
                    mkName = ""
                    For lngCSS = LBound(vrnCSS2) To UBound(vrnCSS2)
                        For cntName = LBound(smName) To UBound(smName)
                            If vrnCSS2(lngCSS) = smName(cntName) Then
                               mkName = mkName & "cls_" & str & "_" & cntName & " "
                            End If
                        Next cntName
                    Next lngCSS
                   .Cells(i, 7).Value = Trim(mkName)
                End If
            End If
        Next i
    End With
End Sub

Private Sub test()
SampleMaking "smsmsms"
End Sub

特殊・他 findメソッド(バージョンによっては使えない)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'※難しいメソッドに思えますが､意外に簡単です
'
'ヘルプにもありますが､ヘルプの方が判り難いかもしれません｡
'対象 Rangeオブジェクト(つまりエクセルのセル)
'構文 expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte)
'expression  検索の対象となるRange オブジェクトを指定（捜される側の範囲）
'引数What    省略不可、（バリアント型）検索する値を指定。
'引数After   省略可能、（バリアント型）検索を開始するセル。単一セルを指定。検索は指定したセルの次から始まる。指定したセル自体は、検索が範囲全体を一度検索して戻ってくるまで検索されません。
'省略すると対象セル範囲の左上端のセルが検索の開始点になる｡
'引数LookIn  省略可能、（バリアント型）セル内の何を対象とするのか指定。
'    xlFormulas  数式    LookIn:=xlValues
'    xlValues 値
'    xlComments コメント
'引数LookAt  省略可能、（バリアント型）検索方法の指定。
'    xlPart  一部分でも含まれていたら    LookAt:=xlPart
'    xlWhole 完全同一値のみ
'省略すると xlPartとなります｡
'引数SearchOrder 省略可能、（バリアント型）検索方向の指定。
'    xlByColumns 列  SearchOrder:=xlByRows
'    xlByRows 行
'引数SearchDirection 省略可能、（バリアント型）検索始点の決定。
'    xlNext  次から  SearchDirection:=xlNext
'    xlPrevious 前から
'省略すると xlNextとなります｡
'引数MatchCase   省略可能、（バリアント型）大文字と小文字の区別。
'    TRUE    区別する    MatchCase:=False
'    FALSE   区別しない
'省略すると Falseとなります｡
'引数MatchByte   省略可能、（バリアント型）半角と全角の区別。
'    TRUE    区別する    MatchByte:=False
'    FALSE   区別しない
'省略すると Falseとなります｡
'返値検索をし最初に見つかったセルを返します｡
'例 .Find(What:="2001", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
'
'使用例

Dim FoundDate As Variant

    Set FoundDate = Worksheet("対象").Columns("A:A").Find(What:="1999/4/5") '①

    If FoundDate Is Nothing Then '②

    MsgBox "nothing  "

    Else

    Worksheet("記録").Range("a1").Value = FoundDate.Offset(0, 1).Value '③

    End If
'解説    上記の例にて、①万一検索対象の「Worksheet.Columns("AD:AD")」セル内に「1999/4/5 12:00:01」の情報値が入っていた場合、必要引数をすべて省略しているため見つかったセル③を返します。しかし、引数LookAtのxlWholeを指定した場合は②Nothingということになります。時間を扱う場合には注意が必要です。
'    でも､大抵の場合全ての引数は省略①してもよいでしょう｡
'    又③では「見つかった場合そのセルのすぐ右横のセルの内容を記録する」になってます。使い方によっては大変便利なメソッドです。
'注意    引数 LookIn、LookAt、SearchOrder、および MatchByte の設定は、このメソッドが使われるたびに保存されます。次にこのメソッドを使うときに、これらの引数の指定を省略すると、保存された設定が使われます。

特殊・他 ByValとByRefによる引数渡し-引数渡しの方法

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Visual Basic 言語の概念

ByVal と ByRef による引数渡し（引数渡しの方法）

Visual Basic では、プロシージャに引数を渡す方法として、ByVal キーワードを使って "値渡し" で渡す方法とByRef キーワードを使って "参照渡し" で渡す方法があります。
【値渡しで引数を渡す】ByVal
と、プロシージャは､引数の基になる呼び出し元のコードの可変要素の内容を変更できません｡
【参照渡しで引数を渡す】ByRef
と、プロシージャは､その内容を呼び出し元のコードと同じように変更できます｡
※引数の値渡しと参照渡しの違いは､データ型における値型と参照型の分類とは異なります｡
※ただし､両者の間に関連性はあります｡
【変更できる引数と変更できない引数】
引数の基になるプログラミング要素には､値を変更できる可変要素と､値を変更できない不変要素があります｡
可変要素と不変要素の一覧を次に示します｡
- 《可変要素》
  - 宣言された変数 (オブジェクト変数を含む)
  - (クラスの) フィールド
  - 配列要素
  - 構造体要素
- 《不変要素》
  - 定数
  - リテラル
  - 列挙定数
  - 式
- 不変の引数は､参照渡しで渡された場合でも､呼び出し元のコードで変更されることはありません｡
- 呼び出したプロシージャによってコピーが変更されることはあっても､その変更が呼び出し元のコードの基の要素に影響することはありません｡
ByVal による引数渡し
値による引数渡しプロシージャは自分で変数を変更できません｡
ByRef による引数渡し
参照による引数渡しプロシージャは自分で変数を変更できます｡
Visual Basic は、指定しない限り、プロシージャの引数は参照渡しByRefで渡されます。

Option Explicit

Sub TestByValandByRef1()
    Dim bytValue As Byte

    bytValue = 5
    Call Test1(bytValue)
    MsgBox bytValue

    bytValue = 5
    Call Test2(bytValue)
    MsgBox bytValue

End Sub

Private Sub Test1(ByVal bytVl As Byte)

bytVl = 1

End Sub

Private Sub Test2(ByRef bytVl As Byte)
'参照による引数渡し
bytVl = 9

End Sub

Sub TestByValandByRef2()
    Dim bytValue As Byte

    bytValue = 5
    Call Test3(bytValue)
    MsgBox bytValue

    bytValue = 5
    Call Test4(bytValue)
    MsgBox bytValue

End Sub

Private Sub Test3(bytVl As Byte)
'●Visual Basic は、指定しない限り、プロシージャの引数は参照渡しByRefで渡されます
bytVl = 1

End Sub

Private Sub Test4(bytVl As Byte)
'●Visual Basic は、指定しない限り、プロシージャの引数は参照渡しByRefで渡されます
bytVl = 9

End Sub

宣言 Constステートメント-図解

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Const ステートメント

Const ステートメント

リテラル値の代わりに使う定数を宣言します。

構文
[Public | Private] Const constname [As type] = expression
Const ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
Public
省略可能です。すべてのモジュール内のすべてのプロシージャから参照可能な定数を宣言するために、モジュールレベルで使用するキーワードです。プロシージャ内では、指定できません。
Private
省略可能です。宣言が行われたモジュール内のプロシージャからのみ参照できる定数を宣言するときに指定するキーワードです。モジュールレベルで使用します。プロシージャ内では指定できません。
constname
必ず指定します。定義する定数の名前を指定します。変数の標準的な名前付け規則に従って指定します。
type
省略可能です。定数のデータ型を指定します。バイト型 (Byte)、ブール型 (Boolean)、整数型 (Integer)、長整数型 (Long)、通貨型 (Currency)、単精度浮動小数点型 (Single)、倍精度浮動小数点数型 (Double)、10 進数型 (Decimal) (現在はサポートされていません)、日付型 (Date)、文字列型 (String)、またはバリアント型 (Variant) のいずれかを指定できます。宣言する各変数に対して、As type 節を個別に指定します。
expression
必ず指定します。リテラル値、その他の定数、Is を除く算術演算子や論理演算子を組み合わせた式を指定します。
解説
既定では、定数はプライベート
になります。プロシージャ内では、定数は常にプライベート定数として扱われて、適用範囲 (スコープ) は変更できません。標準モジュールでは、モジュールレベル定数の既定の適用範囲をキーワード Public で変更できます。一方、クラスモジュールでは、定数はプライベート定数としてのみ使用でき、キーワード Public では適用範囲を変更できません。
複数の定数宣言を 1 行にまとめるには
、定数定義をカンマ (,) で区切ります。このようにして複数の定数を 1 行で宣言した場合、キーワード Public やキーワード Private を指定すると、すべての定数定義に対してキーワードが適用されます。
定数に代入する式の中では、変数、ユーザー定義関数、Chr などの Visual Basic の組込み関数は、使えません。
メモ
定数を使うと、プログラムがわかりやすく、修正も容易になります。変数とは異なり、定数はプログラムの実行中に値を変更できません。
As type で定数のデータ型を明示的に宣言しない場合、代入する式の評価結果に最適なデータ型が割り当てられます。
Sub プロシージャ、Function プロシージャ、または Property プロシージャ内で宣言した定数は、そのプロシージャ内でのみ参照できます。プロシージャの外で宣言された定数は、宣言されたモジュール内であれば、どこからでも参照できます。定数は、式が記述できる位置であれば、どこでも使えます。

Const ステートメントの使用例

判りやすい図解で説明

Module1に以下を記述した。

Module1の記述、有効範囲が示してあります。

Public Constで宣言したものはSheet1・ThisWorkbook・UserForm1・Module1・Module2・Module3が適用範囲になる。

Sheet1・ThisWorkbook・UserForm1・Module1・Module2・Module3から参照したPublic Const～Stringは全て可能

Private Constやプロシージャ内のConst～StringはSheet1・ThisWorkbook・UserForm1・Module2・Module3では参照出来ない。

プロシージャ内のConst～StringはModule1のModule1test1の範囲だけ有効、Module1test2では参照出来ない。

特殊・他 ByValとByRefによる引数渡し-応用高等編

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ByRefstrFileName()
'**************************************************
'多次元変数のプロシージャ間の受け渡し（大量データ）
'**************************************************
'呼び出し側
'可変変数

Dim strFileName() As String
Dim i As Long

'変数の値を別のプロシージャでセットさせる
Call FileNameEnumeration(strFileName)

    '変数の最小値から最大値までを読む
    For i = LBound(strFileName) To UBound(strFileName)

        MsgBox strFileName(i)

    Next i

End Sub

Sub FileNameEnumeration(ByRef strFileName() As String)
'***********************************************
'指定フォルダ内のファイル名一覧を取得列挙する。
'***********************************************
'呼び出される側
'可変変数

Dim strPath As String
Dim buf As String, i As Long
Dim strExtension As String

strPath = ThisWorkbook.Path & "\www\BasicFile\take\" 'パス指定
strExtension = "txt" '指定拡張子
i = 0 'デフォルトでは0

    buf = Dir(strPath & "\*." & strExtension)
    Do While buf <> ""
    '変数値を増やす
    ReDim Preserve strFileName(i) As String
        strFileName(i) = buf
        i = i + 1
        buf = Dir()
    Loop

End Sub

Option Explicit

Private Sub TestDB(ByVal CharacterDB As Variant)
Dim i As Long
    For i = LBound(CharacterDB) To UBound(CharacterDB)
        Debug.Print CharacterDB(i)
    Next i
End Sub

Private Sub Test()
Dim CharacterDB() As String
Dim i As Long

    For i = 0 To 20
        ReDim Preserve CharacterDB(i)
        CharacterDB(i) = i * 10
    Next i

Call TestDB(CharacterDB())

End Sub

宣言 Typeステートメントユーザー定義のデータ型宣言

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'1 つまたは複数の要素を持つユーザー定義のデータ型 (ユーザー定義型) を宣言します。モジュールレベルで使います。
'
'構文
'
'[Private | Public] Type varname
'elementname [([subscripts])] As type
'[elementname [([subscripts])] As type]
'. . .
'
'End Type

'Type ステートメントの構文は､次の指定項目から構成されます｡
'
'指定項目
'Public
'Private
'varname
'elementname
'subscripts
'
'
'type
'
'解説
'
'Type ステートメントは、モジュールレベルでのみ使用できます。Type ステートメントでユーザー定義型を宣言すると、その宣言の適用範囲内であれば、どこからでもその型の変数を宣言できるようになります。ユーザー定義型の変数の宣言には、Dim、Private、Public、ReDim、または Static のいずれかのステートメントを使います。
'
'標準モジュールでは、ユーザー定義型は既定でパブリックになり、その適用範囲はキーワード Public で変更できます。クラスモジュールでは、ユーザー定義型は常にプライベートになり、適用範囲はキーワード Public では変更できません。
'
'Type...End Type ブロック内では、行番号と行ラベルは使えません。
'
'ユーザー定義型は､データ型の異なる多数の関連する要素で構成されるデータレコードでよく使われます｡
'
'次の例は､ユーザー定義型の中に固定サイズの配列を含めたものです｡

Type StateData
    CityCode(1 To 100) As Integer     ' サイズ固定型 (静的) 配列を宣言します。
    County As String * 30
End Type

Dim Washington(1 To 100) As StateData

'この例では、StateData には固定サイズの配列 CityCode が含まれており、レコード Washington は StateData と同じ構造になっています。
'
'ユーザー定義型の中で固定サイズの配列を宣言する場合は､変数ではなく数値リテラルまたは数値定数を使って､次元を宣言する必要があります｡
'
'Type ステートメントの使用例
'
'次の例では、Type ステートメントを使って、ユーザー定義のデータ型を定義します。Type ステートメントは、モジュールレベルでのみ使用します。クラスモジュールで使用する場合は、Type ステートメントの直前にキーワード Private を付ける必要があります。

Type EmployeeRecord        ' ユーザー定義型を作成します。
    ID As Integer            ' データ型の要素を定義します。
    Name As String * 20
    Address As String * 30
    Phone As Long
    HireDate As Date
End Type
Sub CreateRecord()
    Dim MyRecord As EmployeeRecord    ' 変数を宣言します。

    ' 変数 EmployeeRecord への代入は、
    ' プロシージャ内に記述しなければなりません。
    MyRecord.ID = 12003            ' 要素に値を代入します。
End Sub

宣言 SubプロシージャとFunctionプロシージャの呼び出し

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'Sub プロシージャを別のプロシージャから呼び出すには､プロシージャ名を入力し､必要な引数の値を指定します｡
'Call ステートメントは必要ありませんが、Call ステートメントを記述する場合は、引数をかっこで囲まなければなりません。
'
'●例
'Sub プロシージャ Main は Sub プロシージャ MultiBeep を呼び出し、
'引数として値 56 を引き渡します。MultiBeep が実行されると、
'制御は Main に戻り、Main は、Sub プロシージャ Message を呼び出します。Message は、メッセージボックスを表示します。
'ユーザーが [OK] をクリックすると、制御は Main に戻り、Main は終了します。

Sub Main()
MultiBeep 56
Message
End Sub

Sub MultiBeep(numbeeps)
For counter = 1 To numbeeps
Beep
Next counter
End Sub

Sub Message()
MsgBox "休憩の時間です。"
End Sub

'●複数の引数を持つ Sub プロシージャの呼び出し
'次のコード例は、複数の引数を持つ Sub プロシージャを呼び出す方法として、2 つの方法を示しています。
'2 度目に HouseCalc を呼び出すときは、Call ステートメントを使用するので、引数をかっこで囲む必要があります。

Sub Main()
HouseCalc 99800, 43100
Call HouseCalc(380950, 49500)
End Sub

Sub HouseCalc(price As Single, wage As Single)
If 2.5 * wage <= 0.8 * price Then
MsgBox "この家は購入不可能です。"
Else
MsgBox "この家は購入可能です。"
End If
End Sub

'Function プロシージャ呼び出し時のかっこの使い方
'
'●関数の戻り値を使用するには､次のコード例のように､式の中で関数を変数に代入して､引数をかっこで囲みます｡
'answer3 = MsgBox("現在の給与に満足していますか ?", 4, "質問 3")
'●関数の戻り値が不要の場合は､Sub プロシージャを呼び出すときと同じ方法で関数を呼び出すことができます｡
'次のコード例のように､かっこを省略して引数リストを指定し､関数を変数に代入しないように記述します｡
'MsgBox "作業が完了しました。", 0, "作業ボックス"
'注意このコード例で､引数をかっこで囲むと､構文エラーになります｡
'●名前付き引数の引き渡し
'Sub プロシージャおよび Function プロシージャのステートメントは、名前付き引数を使って、
'呼び出すプロシージャに値を引き渡すことができます｡名前付き引数を使う場合､構文で決まっている記述順序に関係なく､
'任意の順序で指定できます。名前付き引数に値を代入するには、引数名、コロンと等号 (:=)、引数に代入する値の順で記述します。
'●例名前付き引数を使って MsgBox 関数を呼び出します。戻り値は無視します。
'MsgBox Title:="作業ボックス", Prompt:="作業が完了しました。"
'●例名前付き引数を使って MsgBox 関数を呼び出します。戻り値は、変数 answer3 に代入されます。
'answer3 = MsgBox(Title:="質問 3", Prompt:="現在の給与に満足していますか ?", Buttons:=4)
'

宣言 ReDimステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

ReDim ステートメント

ReDim ステートメント

動的配列変数に対するメモリ領域の再割り当てを行います。プロシージャレベルで使用します。

構文
ReDim [Preserve] varname(subscripts) [As type] [, varname(subscripts) [As type]] . . .
ReDim ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
Preserve
省略可能です。既存の配列に格納されている値を失うことなく、配列の最後の次元の要素数を変更する場合に使用する、キーワードです。
varname
必ず指定します。宣言する変数の名前です。変数の標準的な名前付け規則に従って指定します。
subscripts
必ず指定します。配列変数の次元を指定します。指定できる次元数の最大値は 60 です。
subscripts
引数 subscripts の構文は、次のとおりです。
[lower To] upper [,[lower To] upper] . . .
引数 lower を省略した場合
、配列の添字の最小値は Option Base ステートメントによって制御されます。Option Base ステートメントが記述されていなければ、添字の最小値は 0 になります。
type
省略可能です。変数のデータ型を指定します。バイト型 (Byte)、ブール型 (Boolean)、整数型 (Integer)、長整数型 (Long)、通貨型 (Currency)、単精度浮動小数点数型 (Single)、倍精度浮動小数点数型 (Double)、10 進型 (Decimal) (現在はサポートされていません)、日付型 (Date)、文字列型 (String) (可変長の場合は String、固定長の場合は String * length)、オブジェクト型 (Object)、バリアント型 (Variant)、ユーザー定義型、またはオブジェクトの種類のいずれかを指定できます。As type 節は、宣言する各変数に対して個別に指定します。バリアント型 (Variant) で配列を格納する場合、引数 type で指定するのは配列の各要素のデータ型です。この引数でバリアント型をほかのデータ型に変えることはできません。
解説
ReDim ステートメント
は、動的配列を宣言したり、Private、Public、または Dim の各ステートメントにおいて、次元の添字を省略した空のかっこだけを指定して宣言されている動的配列の、要素数や次元数を変更するときに使います。
ReDim ステートメント
は、配列の要素数や次元数を変更するために何回でも使うことができます。ただし、バリアント型 (Variant) に格納されている配列を除き、一度あるデータ型で宣言された配列のデータ型を ReDim ステートメントで別のデータ型に変更することはできません。配列がバリアント型に格納されている場合、As type 節を使用して要素のデータ型を変更できます。ただし、キーワード Preserve を使用している場合は、データ型の変更は許可されません。
キーワード Preserve
を指定した場合、変更できるのは、動的配列の最後の次元のサイズに限られます。また、次元数は変更できません。たとえば、次元が 1 つしかない動的配列の場合、その次元は最後のただ 1 つの次元なので、その次元のサイズを変更できます。次元が 2 つ以上ある動的配列の場合、最後の次元のサイズのみを変更でき、その配列に格納されている値は保持されます。ただし、ほかの次元の大きさは変更できません。次の例では、既に格納されている値を保持したまま、動的配列の最後の次元のサイズを増やします。
ReDim X(10, 10, 10)
ReDim Preserve X(10, 10, 15)
キーワード Preserve
を使用した場合、動的配列のサイズを変更するために変えられるのは、添字の上限だけです。添字の下限を変更しようとすると、エラーが発生します。
配列のサイズ
を小さくすると、削除された配列の要素に格納されていた値は、失われます。プロシージャに配列を参照渡しで引き渡した場合、プロシージャ内で配列の再定義を行うことはできません。
変数の初期化時
には、数値変数は 0 に、可変長文字列は長さ 0 の文字列 ("") に初期化されて、固定長文字列には 0 が埋められます。また、バリアント型 (Variant) 変数は Empty 値に初期化されます。ユーザー定義型変数の各要素は、個別の変数として初期化されます。オブジェクトを参照する変数には、あらかじめ Set ステートメントで既存のオブジェクトを代入しておく必要があります。既存のオブジェクトを代入するまで、オブジェクト変数には、特殊な値である Nothing が格納されています。これは、オブジェクト変数がオブジェクトの特定のインスタンスを参照していないことを表す値です。
メモ
宣言した変数
がモジュールレベルまたはプロシージャレベルにない場合、ReDim ステートメントは宣言ステートメントと同様の働きをします。同じ名前を持つほかの変数が後で作成されると、その変数の適用範囲 (スコープ) が広く、Option Explicit ステートメントが指定されている場合でも、ReDim ステートメントは後で作成された変数を参照し、コンパイルエラーは発生しません。このような名前の競合を避けるには、ReDim ステートメントは宣言ステートメントとして使わず、配列を再定義するためだけに使用します。
メモ
バリアント型 (Variant) に格納された配列のサイズを変更するには、まず最初にバリアント型変数を明示的に宣言する必要があります。

ReDim ステートメントの使用例

次の例では、ReDim ステートメントを使って、動的配列変数を保存するメモリ領域の割り当てと再割り当てを行います。Option Base ステートメントには、1 が設定されているものとします。

Dim MyArray() As Integer        ' 動的配列を宣言します。
ReDim MyArray(5)                ' 5 要素分の領域を割り当てます。
For i = 1 To 5                  ' 5 回、ループします。
    MyArray(i) = i              ' 配列を初期化します。
Next i

次のステートメントは､配列のサイズを変更して､以前の要素を消去します｡

ReDim MyArray(10)               ' 配列の要素数を 10 に変更します。
For i = 1 To 10                 ' 10 回、ループします。
    MyArray(i) = i              ' 配列を初期化します。
Next i

次のステートメントでは､以前の要素を消去せずに､配列のサイズを変更します｡

ReDim Preserve MyArray(15)
                                ' 配列の要素数を 15 に変更します。

宣言 Subステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'Sub プロシージャの名前､引数､およびプロシージャの本体を宣言します｡()
'
'構文
'
'[Private | Public | Friend] [Static] Sub name [(arglist)]
'[statements]
'[Exit Sub]
'[statements]
'
'End Sub

'Sub ステートメントの構文は､次の指定項目から構成されます｡()
'
'指定項目
'Public
'Private
'Friend
'Static
'name
'arglist
'statements
'
'引数 arglist は、次の形式で指定します。
'
'[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
'
'指定項目
'Optional
'ByVal
'ByRef
'ParamArray
'varname
'type
'defaultvalue
'
'解説
'
'キーワード Public、Private、または Friend を指定しない場合、Sub プロシージャは、パブリックプロシージャになります。キーワード Static を指定しない場合、ローカル変数の値は、Sub プロシージャの実行が終了すると破棄されます。キーワード Friend は、クラスモジュール内でのみ使えます。ただし、Friend を指定したプロシージャは、プロジェクト内のすべてのモジュールのプロシージャから呼び出せます。Friend を指定したプロシージャは、親クラスのタイプライブラリには書き込まれません。また、実行時バインディングは行えません。
'
'メモ Sub プロシージャは、再帰的に使えます。つまり、そのプロシージャ自体を呼び出して機能を実行できます。ただし、再帰呼び出しを行うと、スタックがオーバーフローする可能性があります。キーワード Static は、通常、再帰的な Sub プロシージャでは使いません。
'
'実行可能なコードは、すべてプロシージャ内に記述する必要があります。また、Sub プロシージャをほかの Sub プロシージャ、Function プロシージャ、Property プロシージャの中では定義できません。
'
'キーワード Exit Sub は、Sub プロシージャを直ちに終了させます。プログラムの実行は、その Sub プロシージャを呼び出したステートメントの次のステートメントから続行されます。Exit Sub ステートメントは、Sub プロシージャ内の任意の場所に、必要に応じていくつでも記述できます。
'
'Function プロシージャと同様に、Sub プロシージャは、引数を受け取り、一連のステートメントを実行して、引数の値を変更します。ただし、値を返す Function プロシージャとは異なり、Sub プロシージャは値を返さないため、式の中には記述できません。
'
'Sub プロシージャを呼び出すには、プロシージャ名の後ろに引数リストを付けて指定します。Sub プロシージャを呼び出す方法については、Call ステートメントを参照してください。
'
'Sub プロシージャで使う変数には、Sub プロシージャ内で明示的に宣言される変数と、それ以外の変数の 2 種類があります。プロシージャ内で Dim などのステートメントで明示的に宣言された変数 (ローカル変数) は、そのプロシージャの中だけで有効です。プロシージャ内で明示的に宣言されていない変数も、そのプロシージャの外部のさらに上のレベルで明示的に宣言されていない限り、ローカル変数となります。
'
'メモプロシージャ内で明示的に宣言されていない変数をプロシージャ内で使うことも可能ですが、その変数と同じ名前の変数などがモジュールレベルで定義されている場合、名前の競合が発生します。あるプロシージャにおいて、ほかのプロシージャ、定数または変数のいずれかと同じ名前を持つ未宣言の変数を参照した場合、そのモジュールレベルの名前を参照しているものと見なされます。このような名前の競合を避けるためには、変数を明示的に宣言する必要があります。Option Explicit ステートメントを使うと、変数の明示的な宣言が強制されます。
'
'メモ GoSub、GoTo、Return などのステートメントを使って、Sub プロシージャに入ったり、Sub プロシージャから抜けたりすることはできません。
'
'Sub ステートメントの使用例()
'
'次の例は、Sub ステートメントを使って、Sub プロシージャの名前と引数を宣言し、プロシージャのコードを記述しています。

' Sub プロシージャを定義します。
' 2 つの引数を持つ Sub プロシージャになります。
Sub SubComputeArea(Length, TheWidth)
    Dim Area As Double        ' ローカル変数を宣言します。
    If Length = 0 Or TheWidth = 0 Then
        ' いずれかの変数の値が 0 の場合
        Exit Sub            ' Sub プロシージャを直ちに終了します。
    End If
    Area = Length * TheWidth    ' 四角形の面積を計算します。
    Debug.Print Area        ' 面積をデバッグウィンドウに表示します。
End Sub

宣言引数が省略可能な関数を作る

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'======================================================================
'【通常】
Function OptionalTest1(A As Byte, B As Byte, C As Byte) As Byte
'**********************************
'引数が省略可能な関数を作る
'**********************************
'ユーザー定義関数

OptionalTest1 = A + B + C

End Function

Private Sub Test1()
MsgBox OptionalTest1(1, 2, 3)
End Sub

'======================================================================
'【省略可能型1】
Function OptionalTest2(A As Byte, B As Byte, Optional C As Byte = 0) As Byte
' ~~~~~~~~ ~~~
'**********************************
'引数が省略可能な関数を作る
'**********************************
'ユーザー定義関数
'[= 0]の数値は任意(省略された場合の数値)で設定可能です。

OptionalTest2 = A + B + C

End Function

Private Sub Test2_1()
MsgBox OptionalTest1(1, 2) '【通常】
'↑コンパイルエラー！引数は省略できません！
End Sub

Private Sub Test2_2()
MsgBox OptionalTest2(1, 2) '【省略可能型1】
'↑エラーは無く答えが表示されます。
End Sub

'======================================================================
'【省略可能型2】
Function OptionalTest3(A As Byte, Optional B As Byte = 0, Optional C As Byte = 0) As Byte
' ~~~~~~~~ ~~~ ~~~~~~~~ ~~~
'**********************************
'引数が省略可能な関数を作る
'**********************************
'ユーザー定義関数
'[= 0]の数値は任意(省略された場合の数値)で設定可能です。

OptionalTest3 = A + B + C

End Function

Private Sub Test3()
    MsgBox OptionalTest3(1) '【省略可能型2】
    '↑エラーは無く答えが表示されます。
    MsgBox OptionalTest3(1, 2) '【省略可能型2】
    '↑エラーは無く答えが表示されます。
    MsgBox OptionalTest3(1, , 3) '【省略可能型2】
    '↑エラーは無く答えが表示されます。
End Sub

'======================================================================
'【注意】
'Function OptionalTest3(Optional A As Byte = 0, B As Byte , Optional C As Byte = 0) As Byte
'                       ~~~~~~~~           ~~~              ~~~~~~~~           ~~~
'**********************************************************************
'[Optional]を指定した場合、それ以降の引数も省略可能でなければならない。
'**********************************************************************
'その場合すべて引数に[Optional]を付けて宣言する必要があります。
'**********************************************************************

'[Optional] キーワード
'[Optional] は、次の構文で使用します。
'
'Declare ステートメント
'
'Function ステートメント
'
'Property Get ステートメント
'
'Property Let ステートメント
'
'Property Set ステートメント
'
'Sub ステートメント

宣言 Typeプロパティ・ユーザー定義のデータ型宣言

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の例では、4 つの異なる Recordset オブジェクトに対応している Type プロパティの定数名を返して、Type プロパティを説明します。このプロシージャを実行するには、RecordsetType 関数が必要です。

Sub TypeX()

    Dim dbsNorthwind As Database
    Dim rstEmployees As Recordset

    Set dbsNorthwind = OpenDatabase("Northwind.mdb")

    ' 既定値は dbOpenTable です。
    Set rstEmployees = _
        dbsNorthwind.OpenRecordset("Employees")
    Debug.Print _
        "Table-type recordset (Employees table): " & _
        RecordsetType(rstEmployees.Type)
    rstEmployees.Close

    Set rstEmployees = _
        dbsNorthwind.OpenRecordset("Employees", _
        dbOpenDynaset)
    Debug.Print _
        "Dynaset-type recordset (Employees table): " & _
        RecordsetType(rstEmployees.Type)
    rstEmployees.Close

    Set rstEmployees = _
        dbsNorthwind.OpenRecordset("Employees", _
        dbOpenSnapshot)
    Debug.Print _
        "Snapshot-type recordset (Employees table): " & _
        RecordsetType(rstEmployees.Type)
    rstEmployees.Close

    Set rstEmployees = _
        dbsNorthwind.OpenRecordset("Employees", _
        dbOpenForwardOnly)
    Debug.Print _
        "Forward-only-type recordset (Employees table): " & _
        RecordsetType(rstEmployees.Type)
    rstEmployees.Close

    dbsNorthwind.Close

End Sub

Function RecordsetType(intType As Integer) As String

    Select Case intType
        Case dbOpenTable
            RecordsetType = "dbOpenTable"
        Case dbOpenDynaset
            RecordsetType = "dbOpenDynaset"
        Case dbOpenSnapshot
            RecordsetType = "dbOpenSnapshot"
        Case dbOpenForwardOnly
            RecordsetType = "dbOpenForwardOnly"
    End Select

End Function

'次の例では、Employees テーブル内のすべての Field オブジェクトの Type プロパティに対応している定数名を返して、Type プロパティを説明します。このプロシージャを実行するには、FieldType 関数が必要です。

Sub TypeX2()

    Dim dbsNorthwind As Database
    Dim fldLoop As Field

    Set dbsNorthwind = OpenDatabase("Northwind.mdb")

    Debug.Print "Fields in Employees TableDef:"
    Debug.Print "    Type - Name"

    ' Employees テーブルの Fields コレクションを列挙します。
    For Each fldLoop In _
        dbsNorthwind.TableDefs Employees.Fields
        Debug.Print "        " & FieldType(fldLoop.Type) & _
            " - " & fldLoop.Name
    Next fldLoop

    dbsNorthwind.Close

End Sub

Function FieldType(intType As Integer) As String

    Select Case intType
        Case dbBoolean
            FieldType = "dbBoolean"
        Case dbByte
            FieldType = "dbByte"
        Case dbInteger
            FieldType = "dbInteger"
        Case dbLong
            FieldType = "dbLong"
        Case dbCurrency
            FieldType = "dbCurrency"
        Case dbSingle
            FieldType = "dbSingle"
        Case dbDouble
            FieldType = "dbDouble"
        Case dbDate
            FieldType = "dbDate"
        Case dbText
            FieldType = "dbText"
        Case dbLongBinary
            FieldType = "dbLongBinary"
        Case dbMemo
            FieldType = "dbMemo"
        Case dbGUID
            FieldType = "dbGUID"
    End Select

End Function

'次の例では、データベース Northwind のすべての QueryDef オブジェクトの Type プロパティに対応している定数名を返して、Type プロパティを説明します。このプロシージャを実行するには、QueryDefType 関数が必要です。

Sub TypeX3()

    Dim dbsNorthwind As Database
    Dim qdfLoop As QueryDef

    Set dbsNorthwind = OpenDatabase("Northwind.mdb")

    Debug.Print "QueryDefs in Northwind Database:"
    Debug.Print "    Type - Name"

    ' データベース Northwind の QueryDefs コレクションを列挙します。
    For Each qdfLoop In dbsNorthwind.QueryDefs
        Debug.Print "        " & _
            QueryDefType(qdfLoop.Type) & " - " & qdfLoop.Name
    Next qdfLoop

    dbsNorthwind.Close

End Sub

Function QueryDefType(intType As Integer) As String

    Select Case intType
        Case dbQSelect
            QueryDefType = "dbQSelect"
        Case dbQAction
            QueryDefType = "dbQAction"
        Case dbQCrosstab
            QueryDefType = "dbQCrosstab"
        Case dbQDelete
            QueryDefType = "dbQDelete"
        Case dbQUpdate
            QueryDefType = "dbQUpdate"
        Case dbQAppend
            QueryDefType = "dbQAppend"
        Case dbQMakeTable
            QueryDefType = "dbQMakeTable"
        Case dbQDDL
            QueryDefType = "dbQDDL"
        Case dbQSQLPassThrough
            QueryDefType = "dbQSQLPassThrough"
        Case dbQSetOperation
            QueryDefType = "dbQSetOperation"
        Case dbQSPTBulk
            QueryDefType = "dbQSPTBulk"
    End Select

End Function

宣言配列の規定最小値を「1」に変更する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Base ステートメント

配列の添字の最小値の既定値を設定します。モジュールレベルで使用します。

構文
Option Base {0 | 1}
解説
添字の既定の最小値
は 0 なので、Option Base ステートメントは必ずしも必要ではありません。Option Base ステートメントを使用する場合は、このステートメントをモジュール内のどのプロシージャよりも前に記述する必要があります。Option Base ステートメントは、モジュール内で一度だけ、次元を含む配列の宣言よりも前に記述します。
メモ
Dim、Private、Public、ReDim、Static などの各ステートメントで To 節を使うと、より柔軟に配列の添字の範囲を設定できます。ただし、To 節で配列の添字の最小値を明示的に設定しない場合は、Option Base ステートメントを使って既定の最小値を 1 に設定できます。Array 関数またはキーワード ParamArray を使って作成する配列の添字の最小値は 0 です。Option Base ステートメントは、Array 関数またはキーワード ParamArray に影響を与えません。
Option Base ステートメントの設定が有効
になるのは、ステートメントが記述されているモジュール内の配列の添字の最小値のみです。

Option Base ステートメントの使用例

次の例では、Option Base ステートメントを使って、配列の添字の既定の最小値 0 を変更します。LBound 関数は、配列内の指定された次元の添字の最小値を返します。Option Base ステートメントは、モジュールレベルでのみ使います。

Option Explicit

Option Base 1 ' 配列の添字の既定値を 1 に設定します。

Private Sub Test()

Dim Lower
Dim MyArray(20), TwoDArray(3, 4)        ' 配列変数を宣言します。
Dim ZeroArray(0 To 5)                   ' 添字の既定の最小値を変更します。
' 配列の添字の最小値を求めるには、LBound 関数を使います。
Debug.Print LBound(MyArray)                  ' 1 が返ります。
Debug.Print LBound(TwoDArray, 2)             ' 1 が返ります。
Debug.Print LBound(ZeroArray)                ' 0 が返ります。
'1
'1
'0
End Sub

制御制御構造に関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'分岐 GoSub...Return, GoTo, On Error, On...GoSub, On...GoTo
'プログラムの終了または一時停止 DoEvents, End, Exit, Stop
'ループ Do...Loop, For...Next, For Each...Next, While...Wend, With
'意志決定 Choose, If...Then...Else, Select Case, Switch
'プロシージャの使用 Call, Function, Property Get, Property Let, Property Set, Sub

制御実行を繰り返すフロー制御ステートメントWhile～Wend

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

While...Wend ステートメント

While...Wend ステートメント

指定した条件が真 (True) である間、一連のステートメントの実行を繰り返すフロー制御ステートメントです。

構文
While condition
[statements]
Wend
While...Wend ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
condition
必ず指定します。
真 (True) または偽 (False) を評価する数式あるいは文字列式を指定します。
引数 condition の値が Null 値の場合、引数 condition は偽 (False) であるとみなされます。
statements
省略可能です。
引数 condition が真 (True) の間に実行する 1 つまたは複数のステートメントを指定します。
解説
引数 condition が真 (True) の場合、Wend ステートメントまでのすべての引数 statements が実行されます。
実行が Wend ステートメントに達すると、制御は再び While ステートメントに戻り、引数 condition が調べられます。
引数 condition が真 (True) の場合は、このプロセスが繰り返されます。
偽 (False) の場合は、Wend ステートメントの次のステートメントに制御が移ります。
While...Wend ループは任意のレベルでネスト (入れ子) 構造にすることができます。
Wend ステートメントは最後に実行された While ステートメントに対応します。
ヒント
Do...Loop ステートメントを使うと、より構造化された柔軟なループを記述することができます。

While...Wend ステートメントの使用例

次の例は、While...Wend ステートメントを使って、カウンタ変数 (i) の値を増加させます。ループ内に記述されたステートメントは、条件の評価が真 (True) の間、実行されます。

Option Explicit

Private Sub test()
'************************************************
'あるコレクションの中の特定要素数になれば抜ける
'************************************************

Dim MyCollection As Variant
Dim i As Long
MyCollection = Array(10, 20, 30, 40, 50, 30)
'初期化
i = 0
While i < 3 '値を評価します。
Debug.Print i & ":" & MyCollection(i)
i = i + 1 '値を増やします。
Wend 'While ループを終了します。
'0:10
'1:20
'2:30
End Sub

制御実行を指定時間休止する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Application.Wait Now + TimeValue("00:00:03")

制御実行を繰り返すフロー制御ステートメントDo～While～Loop

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Do While...Loop ステートメント

Do While...Loop ステートメント

While 指定した条件が真 (True) である間

Until 指定した条件が真 (True) になるまで

構文
次の構文を使用できます。
- Do [{While | Until} condition]
- [statements]
- [Exit Do]
- [statements]
- Loop
または、
- Do
- [statements]
- [Exit Do]
- [statements]
- Loop [{While | Until} condition]
Do...Loop ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
condition
省略可能です。
真 (True) または偽 (False) を評価する数式、あるいは文字列式を指定します。
引数 condition の値が Null 値の場合、引数 condition は偽 (False) であるとみなされます。
statements
引数 condition が真 (True) である間、または引数 condition が真 (True) になるまで繰り返し実行される、任意の行数のステートメントを記述します。
解説
Do...Loop ステートメントから抜け出す別の方法として、Do...Loop ステートメント内に任意の数の Exit Do ステートメントを指定することができます。
通常、Exit Do ステートメントはいくつかの条件を評価した後で使用します。
たとえば、If...Then ステートメントを評価した後で Exit Do ステートメントを実行して、制御をキーワード Loop の次のステートメントに直ちに移します。
Do...Loop ステートメントはネスト (入れ子) 構造にすることができます。
つまり、Do...Loop ステートメントの内部に別の Do...Loop ステートメントを入れることができます。
ネスト (入れ子) 構造にしたときに Exit Do が実行されると、その Exit Do を囲んでいる 1 番内側のループから抜け出します。

Do While...Loop ステートメントの使用例

Option Explicit

Private Sub Test1()
'*****************************************************
'指定されたディレクトリをループして内容を返す
'*****************************************************
'条件式を満たすまで繰り返す
'Do While...Loop

Dim pth As String
Dim buf As String
Dim x As Long

pth = ThisWorkbook.Path & "\"
x = 0

buf = Dir(pth, vbDirectory)

    Do While Len(buf) <> 0
        Debug.Print "x" & x & ":" & buf
        x = x + 1
        ' Dir関数を使用して、次の検索をします。
        buf = Dir()
    Loop

'x0:.
'x1:..
'x2: test1.jpg
'x3: test1.txt
'x4: test1.xls
'x5: test2.txt
'x6: testDirectory

End Sub

Private Sub Test2()
'*****************************************************
'指定されたディレクトリをループして内容を返す
'*****************************************************
'条件式を満たすまで繰り返す
'Do ...Loop While

Dim pth As String
Dim buf As String
Dim x As Long

pth = ThisWorkbook.Path & "\"
x = 0

buf = Dir(pth, vbDirectory)

    Do
        Debug.Print "x" & x & ":" & buf
        x = x + 1
        ' Dir関数を使用して、次の検索をします。
        buf = Dir()
    Loop While Len(buf) <> 0

'x0:.
'x1:..
'x2: test1.jpg
'x3: test1.txt
'x4: test1.xls
'x5: test2.txt
'x6: testDirectory

End Sub

Private Sub Test3()
'*****************************************************
'指定されたディレクトリをループして各ファイル名を返す
'*****************************************************

Dim pth As String
Dim buf As String
Dim i As Long, x As Long, y As Long
Dim myDir As String 'カレントフォルダ(自分)
Dim upDir As String 'ルートフォルダ(親フォルダ)
myDir = "."
upDir = ".."

pth = ThisWorkbook.Path & "\"
i = 0: x = 0: y = 0
buf = Dir(pth, vbDirectory)
Do While Len(buf) <> 0
    Debug.Print "x" & x & ":" & buf
x = x + 1
If (buf <> myDir) And (buf <> upDir) Then
    Debug.Print "y" & y & ":" & buf
    y = y + 1
If (GetAttr(pth & buf) And 16) <> 16 Then
    Debug.Print "i" & i & ":" & buf
    i = i + 1
End If
End If
' Dir関数を使用して、次の検索をします。
buf = Dir()
Loop

'┌──────┬─┬──────────────┐
'│定数        │値│内容                        │
'├──────┼─┼──────────────┤
'│vbNormal    │0 │標準ファイル                │
'│vbReadOnly  │1 │読み取り専用ファイル        │
'│vbHidden    │2 │隠しファイル                │
'│vbSystem    │4 │システムファイル            │
'│vbVolume    │8 │ボリュームラベル            │
'│vbDirectory │16│フォルダ                    │
'│vbAlias     │64│エイリアスファイル(Macのみ) │
'└──────┴─┴──────────────┘
End Sub

制御実行を繰り返すフロー制御ステートメントDo～Until～Loop

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Do Until...Loop ステートメント

Do Until...Loop ステートメント

While 指定した条件が真 (True) である間

Until 指定した条件が真 (True) になるまで

構文
次の構文を使用できます。
- Do [{While | Until} condition]
- [statements]
- [Exit Do]
- [statements]
- Loop
または、
- Do
- [statements]
- [Exit Do]
- [statements]
- Loop [{While | Until} condition]
Do...Loop ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
condition
省略可能です。
真 (True) または偽 (False) を評価する数式、あるいは文字列式を指定します。
引数 condition の値が Null 値の場合、引数 condition は偽 (False) であるとみなされます。
statements
引数 condition が真 (True) である間、または引数 condition が真 (True) になるまで繰り返し実行される、任意の行数のステートメントを記述します。
解説
Do...Loop ステートメントから抜け出す別の方法として、Do...Loop ステートメント内に任意の数の Exit Do ステートメントを指定することができます。
通常、Exit Do ステートメントはいくつかの条件を評価した後で使用します。
たとえば、If...Then ステートメントを評価した後で Exit Do ステートメントを実行して、制御をキーワード Loop の次のステートメントに直ちに移します。
Do...Loop ステートメントはネスト (入れ子) 構造にすることができます。
つまり、Do...Loop ステートメントの内部に別の Do...Loop ステートメントを入れることができます。
ネスト (入れ子) 構造にしたときに Exit Do が実行されると、その Exit Do を囲んでいる 1 番内側のループから抜け出します。

Do Until...Loop ステートメントの使用例

Option Explicit

Private Sub Test1()
'*****************************************************
'指定されたディレクトリをループして内容を返す
'*****************************************************
'条件式を満たすまで繰り返す
'Do Until...Loop

Dim pth As String
Dim buf As String
Dim x As Long

pth = ThisWorkbook.Path & "\"
x = 0

buf = Dir(pth, vbDirectory)

    Do Until Len(buf) = 0
        Debug.Print "x" & x & ":" & buf
        x = x + 1
        ' Dir関数を使用して、次の検索をします。
        buf = Dir()
    Loop

'x0:.
'x1:..
'x2: test1.jpg
'x3: test1.txt
'x4: test1.xls
'x5: test2.txt
'x6: testDirectory

End Sub

Private Sub Test2()
'*****************************************************
'指定されたディレクトリをループして内容を返す
'*****************************************************
'条件式を満たすまで繰り返す
'Do ...Loop Until

Dim pth As String
Dim buf As String
Dim x As Long

pth = ThisWorkbook.Path & "\"
x = 0

buf = Dir(pth, vbDirectory)

    Do
        Debug.Print "x" & x & ":" & buf
        x = x + 1
        ' Dir関数を使用して、次の検索をします。
        buf = Dir()
    Loop Until Len(buf) = 0

'x0:.
'x1:..
'x2: test1.jpg
'x3: test1.txt
'x4: test1.xls
'x5: test2.txt
'x6: testDirectory

End Sub

Private Sub Test3()
'*****************************************************
'指定されたディレクトリをループして各ファイル名を返す
'*****************************************************

Dim pth As String
Dim buf As String
Dim i As Long, x As Long, y As Long
Dim myDir As String 'カレントフォルダ(自分)
Dim upDir As String 'ルートフォルダ(親フォルダ)
myDir = "."
upDir = ".."

pth = ThisWorkbook.Path & "\"
i = 0: x = 0: y = 0
buf = Dir(pth, vbDirectory)
Do Until Len(buf) = 0
    Debug.Print "x" & x & ":" & buf
x = x + 1
If (buf <> myDir) And (buf <> upDir) Then
    Debug.Print "y" & y & ":" & buf
    y = y + 1
If (GetAttr(pth & buf) And 16) <> 16 Then
    Debug.Print "i" & i & ":" & buf
    i = i + 1
End If
End If
' Dir関数を使用して、次の検索をします。
buf = Dir()
Loop

'┌──────┬─┬──────────────┐
'│定数        │値│内容                        │
'├──────┼─┼──────────────┤
'│vbNormal    │0 │標準ファイル                │
'│vbReadOnly  │1 │読み取り専用ファイル        │
'│vbHidden    │2 │隠しファイル                │
'│vbSystem    │4 │システムファイル            │
'│vbVolume    │8 │ボリュームラベル            │
'│vbDirectory │16│フォルダ                    │
'│vbAlias     │64│エイリアスファイル(Macのみ) │
'└──────┴─┴──────────────┘
End Sub

制御実行を繰り返すフロー制御ステートメントFor～Each～Next

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

For Each...Next ステートメント

For Each...Next ステートメント

配列やコレクションの各要素に対して、一連のステートメントを繰り返し実行するフロー制御ステートメントです。

構文
For Each element In group
[statements]
[Exit For]
[statements]
Next [element]
For Each...Next ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
element
必ず指定します。
コレクションや配列の各要素を繰り返す変数を指定します。
コレクションの場合
- 引数 element にはバリアント型 (Variant) 変数
- 総称オブジェクト型変数
- 任意の固有オブジェクト型のオブジェクトの変数
配列の場合
- 引数 element にはバリアント型のみ指定できます。
group
必ず指定します。
- オブジェクトコレクション名
- 配列名 (ユーザー定義型の配列を除く) を指定します。
statements
省略可能です。
引数 group の各メンバに対して実行するステートメントを指定します。
解説
引数 group に要素が 1 つでもある場合、For Each ブロックは始まります。
ループがいったん開始されると、引数 group の最初の要素に対して、ループ内のすべてのステートメントは実行されます。
引数 group の中に要素がある限り、ループ内のステートメントは、各要素に対して実行を続けます。
引数 group の中にもう要素がなくなったとき、ループは終了し、Next ステートメントの次のステートメントに実行が移ります。
ループから抜け出す別の方法として、ループ内に任意の数の Exit For ステートメントを指定することができます。
通常、Exit For ステートメントはいくつかの条件を評価した後で使用します。
たとえば、If...Then ステートメントを評価した後で、制御をキーワード Next の次のステートメントに直ちに移します。
For Each...Next ループはネスト (入れ子) 構造にすることができます。
つまり、For Each...Next ループの内部に別の For Each...Next ループを入れることができます。
ループをネスト (入れ子) 構造にするときは、それぞれの引数 element に別の変数名を指定してください。
メモ
Next ステートメントの引数 element を省略すると、引数 element が指定されているかのように実行を継続します。
Next ステートメントが対応する For ステートメントよりも前にあると、エラーが発生します。
For... Each ステートメントをユーザー定義型の配列に使用することはできません。
バリアント型は、ユーザー定義型の配列を持つことができないためです。

For Each...Next ステートメントの使用例

Option Explicit

Private Sub test1()
'************************************************
'あるコレクションの中の要素をすべて返す
'************************************************

Dim Found As Boolean
Dim Element As Variant
Dim MyCollection As Variant
Dim i As Long
MyCollection = Array(10, 20, 30, 40, 50, 30)
'初期化
i = 0
'MyCollectionのElementに対して繰り返します。
    For Each Element In MyCollection
    Found = False
    i = i + 1
    Debug.Print "i" & i & ":" & Found & ":" & Element
    Next
'i1:False:10
'i2:False:20
'i3:False:30
'i4:False:40
'i5:False:50
'i6:False:30
End Sub

Private Sub test2()
'************************************************
'あるコレクションの中の特定要素をすべて返す
'************************************************

Dim Found As Boolean
Dim strFound As String
Dim Element As Variant
Dim MyCollection As Variant
Dim i As Long, n As Long
MyCollection = Array(10, 20, 30, 40, 50, 30)
'初期化
strFound = "30"
i = 0: n = 0
'MyCollectionのElementに対して繰り返します。
    For Each Element In MyCollection
    Found = False
    i = i + 1
    Debug.Print "i" & i & ":" & Found & ":" & Element
        'ElementがstrFoundであれば、
        If Element = strFound Then
        n = n + 1
            'Found にTrueを設定。
            Found = True
            'For ループから抜け出します。
            Debug.Print "n" & n & ":" & Found & ":" & Element
        End If
    Next
'i1:False:10
'i2:False:20
'i3:False:30
'n1:True:30
'i4:False:40
'i5:False:50
'i6:False:30
'n2:True:30
End Sub

Private Sub test3()
'************************************************
'あるコレクションの中の特定要素があれば抜ける
'************************************************

Dim Found As Boolean
Dim strFound As String
Dim Element As Variant
Dim MyCollection As Variant
Dim i As Long, n As Long
MyCollection = Array(10, 20, 30, 40, 50, 30)
'初期化
strFound = "30"
i = 0: n = 0
'MyCollectionのElementに対して繰り返します。
    For Each Element In MyCollection
    Found = False
    i = i + 1
    Debug.Print "i" & i & ":" & Found & ":" & Element
        'ElementがstrFoundであれば、
        If Element = strFound Then
        n = n + 1
            'Found にTrueを設定。
            Found = True
            'For ループから抜け出します。
            Debug.Print "n" & n & ":" & Found & ":" & Element
            Exit For
        End If
    Next
'i1:False:10
'i2:False:20
'i3:False:30
'n1:True:30
End Sub

制御実行を繰り返すフロー制御ステートメントFor～Next

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

For...Next ステートメント

For...Next ステートメント

指定した回数だけ、一連のステートメントを繰り返すフロー制御ステートメントです。

構文
For counter = start To end [Step step]
[statements]
[Exit For]
[statements]
Next [counter]
For...Next ステートメントの構文は、次の指定項目から構成されます。
指定項目内容
counter
必ず指定します。
カウンタに使う数値変数を指定します。
配列変数およびブール型 (Boolean) に含まれる変数は指定できません。
start
必ず指定します。
引数 counter の初期値を指定します。
end
必ず指定します。
引数 counter の最終値を指定します。
step
省略可能です。
ループを繰り返すごとに引数 counter に加算される値を指定します。
引数 step を省略すると、ループを繰り返すごとに引数 counter には 1 が加算されます。
statements
省略可能です。
ループ内で実行される一連のステートメントで、For と Next の間に記述します。
ここに記述したステートメントは、For...Next ステートメントで指定した回数だけ実行されます。
解説
引数 step には正の数または負の数を指定できます。
引数 step で指定した値によりループの実行は次のように制御されます。
値実行条件
正の数または 0 counter <= end
負の数 counter >= end
ループ内の一連のステートメントがすべて実行されると、引数 step の値が引数 counter に加算されます。
この時点で、終了条件が満たされていない場合にはループ内のステートメントが再び実行され、それ以外は、ループから抜け出して Next ステートメントの次のステートメントに制御が移ります。
ヒント
ループ内で引数 counter の値を変えると、プログラムの内容の理解やデバッグが困難になりますので注意してください。
ループから抜け出す別の方法として、ループ内に任意の数の Exit For ステートメントを指定することができます。
通常、Exit For ステートメントはいくつかの条件を評価した後で使用します。
たとえば、If...Then ステートメントを評価した後で、制御をキーワード Next の次のステートメントに直ちに移します。
For...Next ループはネスト (入れ子) 構造にすることができます。
つまり、For...Next ループの内部に別の For...Next ループを入れることができます。
ループをネスト (入れ子) させるときは、それぞれの引数 counter に別の変数名を指定してください。
正しいステートメントの例を次に示します。

Option Explicit

For i = 1 To 10
    For j = 1 To 10
        For K = 1 To 10
            処理
        Next K
    Next j
Next i

メモ
Next ステートメントの引数 counter を省略すると、引数 counter が指定されているかのように実行を継続します。
Next ステートメントが対応する For ステートメントよりも前にあると、エラーが発生します。

For...Next ステートメントの使用例

Option Explicit

Private Sub test1()
Dim Chars, MyString
    For Chars = 0 To 9
        '文字列に番号を追加します。
        Debug.Print "'"; Chars & ":" & MyString
        MyString = MyString & Chars
    Next Chars
'0:
'1:0
'2:01
'3:012
'4:0123
'5:01234
'6:012345
'7:0123456
'8:01234567
'9:012345678

End Sub

Private Sub test2()
Dim Chars, MyString
    For Chars = 10 To 1 Step -1
        '文字列に番号を追加します。
        Debug.Print "'"; Chars & ":" & MyString
        MyString = MyString & Chars
    Next Chars
'10:
'9:10
'8:109
'7:1098
'6:10987
'5:109876
'4:1098765
'3:10987654
'2:109876543
'1:1098765432

End Sub

Private Sub test3()
Dim Chars, MyString
    For Chars = 0 To 10 Step 2
        '文字列に番号を追加します。
        Debug.Print "'"; Chars & ":" & MyString
        MyString = MyString & Chars
    Next Chars
'0:
'2:0
'4:02
'6:024
'8:0246
'10:02468

End Sub

宣言 Option_Privateステートメントプロジェクトの外部からモジュールの内容が参照できなくなります

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Privateステートメント

Option Privateステートメント

構文
Option Private Module
解説
Option Private ステートメントを使用する場合、モジュールレベル内のどのプロシージャよりも前に記述します。
モジュールに Option Private Module ステートメントが含まれている場合でも、モジュールレベルで宣言されているパブリックな要素、たとえば、変数、オブジェクト、およびユーザー定義型は、モジュールを含むプロジェクト内で使用できます。ただし、ほかのアプリケーションまたはプロジェクトでは、使用できません。
メモ
Option Private ステートメントは、ホストアプリケーションが、複数のプロジェクトの同時読み込みをサポートし、プロジェクト間での参照を許可している場合にのみ使用できます。たとえば、Microsoft Excel では、複数のプロジェクトの読み込みが可能で、Option Private Module ステートメントを使用してプロジェクト間の参照を制限できます。Visual Basic では、複数のプロジェクトの読み込みは可能ですが、プロジェクト間での参照は許可されていません。
Option Private ステートメントの使用例
次の例では、Option Private ステートメントをモジュールレベルで使って、モジュール全体をプライベートとして設定します。Option Private Module では、Private 宣言を行っていないモジュールレベルの要素は、そのモジュールが含まれるプロジェクト内からは参照できますが、ほかのアプリケーションやほかのプロジェクトからは参照できません。
Option Private Module
モジュールがプライベートであることを示します｡

宣言 Eraseステートメント動的配列のクリア削除メモリ解放

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Erase ステートメント

Erase ステートメント

固定サイズの配列の場合は要素を再初期化し、動的配列の場合は割り当てたメモリを解放します。

構文
Erase arraylist
必須の引数 arraylist には、消去する配列変数を指定します。複数指定する場合は、カンマ (,) で区切ります。
解説
配列が固定サイズの配列 (通常の配列) であるか、または動的配列であるかによって、Erase ステートメントの動作は異なります。固定サイズの配列の場合、Erase ステートメントはメモリを解放しません。固定配列の要素は、次のように設定されます。
配列の型 Erase ステートメントの実行結果
静的数値配列要素はすべて 0 に設定されます。
静的文字列配列 (可変長) 要素はすべて長さ 0 の文字列 ("") に設定されます。
静的文字列配列 (固定長) 要素はすべて 0 に設定されます。
静的バリアント型 (Variant) 配列要素はすべて Empty 値に設定されます。
ユーザー定義型配列各要素は、別個の変数として設定されます。
オブジェクト配列要素はすべて特別な値 Nothing に設定されます。
Erase ステートメントは、動的配列が使っていたメモリを解放します。プログラムでこの配列を再度参照するには、ReDim ステートメントを使って、再びこの配列変数の次元を宣言する必要があります。

Erase ステートメントの使用例

次の例では、Erase ステートメントを使って、静的配列の要素の再初期化と動的配列のメモリの解放を行っています。

Option Explicit

' 配列変数を宣言します。
Dim NumArray(10) As Integer         ' 整数型の配列。
Dim StrVarArray(10) As String       ' 可変長文字列型の配列。
Dim StrFixArray(10) As String * 10  ' 固定長文字列型の配列。

Dim VarArray(10) As Variant         ' バリアント型の配列。
Dim DynamicArray() As Integer       ' 動的配列。
ReDim DynamicArray(10)              ' メモリ領域を割り当てます。
Erase NumArray                      ' 各要素の値を 0 にします。
Erase StrVarArray                   ' 各要素の値を長さ 0 の
                                    ' 文字列 ("") にします。
Erase StrFixArray                   ' 各要素の値を 0 にします。
Erase VarArray            ' 各要素の値を Empty 値にします。
Erase DynamicArray        ' 配列が占有していたメモリを解放します。

宣言 Option_CompareステートメントBinaryモード・Textモード

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Binary モードテスト/Option Compare Binary

Option Explicit

'文字列比較方法を Binary モードに設定します。
'Option Compare Binary
'↑規定値で明示無しでもBinaryモード

Private Sub testCompareBinary()
Dim A As String, b As String
Dim bln As Boolean, i As Byte

i = i + 1
A = "＊": b = "*" '全角半角
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "Ａ": b = "A" '全角半角
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "A": b = "a" '大文字小文字
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "あ": b = "ア" 'ひらがなカタカナ
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln
'--------------------------------------------------------
i = i + 1
A = "＊": b = "*" '全角半角
    If InStr(1, A, b) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "＊": b = "*" '全角半角/比較モードを指定
    If InStr(1, A, b, vbTextCompare) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "あ": b = "ア" 'ひらがなカタカナ
    If InStr(1, A, b) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "あ": b = "ア" 'ひらがなカタカナ/比較モードを指定
    If InStr(1, A, b, vbTextCompare) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

'1 [＊ : *]     False
'2 [Ａ : A]     False
'3 [A : a]      False
'4 [あ : ア]    False
'5 [＊ : *]     False
'6 [＊ : *]     True
'7 [あ : ア]    False
'8 [あ : ア]    True

End Sub

Text モードテスト/Option Compare Text

Option Explicit

' 文字列比較方法を Text モードに設定します。
Option Compare Text

Private Sub testCompareText()
Dim A As String, b As String
Dim bln As Boolean, i As Byte

i = i + 1
A = "＊": b = "*" '全角半角
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "Ａ": b = "A" '全角半角
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "A": b = "a" '大文字小文字
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "あ": b = "ア" 'ひらがなカタカナ
    If A = b Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln
'--------------------------------------------------------
i = i + 1
A = "＊": b = "*" '全角半角
    If InStr(1, A, b) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "＊": b = "*" '全角半角/比較モードを指定
    If InStr(1, A, b, vbBinaryCompare) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "あ": b = "ア" 'ひらがなカタカナ
    If InStr(1, A, b) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

i = i + 1
A = "あ": b = "ア" 'ひらがなカタカナ/比較モードを指定
    If InStr(1, A, b, vbBinaryCompare) <> 0 Then
        bln = True
    Else
        bln = False
    End If
Debug.Print i & "[" & A & " : " & b & "]" & bln

'1 [＊ : *]     True
'2 [Ａ : A]     True
'3 [A : a]      True
'4 [あ : ア]    True
'5 [＊ : *]     True
'6 [＊ : *]     False
'7 [あ : ア]    True
'8 [あ : ア]    False

End Sub

Option Compare ステートメント

文字列データの既定の比較方法を設定します。モジュールレベルで使います。

構文
Option Compare {Binary | Text | Database}
解説
Option Compare ステートメントを使う場合は、モジュール内のどのプロシージャよりも前に記述する必要があります。
Option Compare ステートメントは、モジュール内での文字列の比較方法 (Binary モード、Text モード、または Database モード) を指定するものです。
Option Compare ステートメントが記述されていないモジュールでは、既定の文字列比較方法である Binary モードが使われます。
Binary モードでは、文字列比較の並べ替え順序は、バイナリ文字コードのコード順によって行われます。
Microsoft WIndows 版 Visual Basicでは、文字コードは Unicode で表現されるので、結果は Unicode のコード順によって決まります。
Binary モードでの並べ替えの例を次に示します。(ただし、バージョン4.0 以前の Windows 16bit 版 Visual Basic、または Macintosh 版 Visual Basic では、文字コードはシフト JISで表現されていたため、結果が異なる場合があります。)
"*" < "a" < "z" < "あ" < "ん" < "ア" < "ン" < "亜" < "＊" < "Ａ" < "ｱ" < "ﾝ"
Text モードでは、文字列比較は、オペレーティングシステムの国別情報の設定で決まります。
日本語/日本の場合は、50 音順で、大文字と小文字、文字幅、カタカナとひらがなを区別しない並べ替え順になります。
Text モードでの並べ替えの例を次に示します。
(*=＊) < (0=０) < (9=９) < (A=a=Ａ=ａ) < (B=b=Ｂ=ｂ) < (ｱ=ア=あ) < (ﾝ=ン=ん) < 亜
Database モードは、Microsoft Access でのみ使用できます。このモードの文字列比較の並べ替え順序は、データベースの文字列比較に適用される国別の ID によって決まります。

Option Compare ステートメントの使用例

宣言 Public/Private

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Const ステートメント

Declare ステートメント

Enum ステートメント

Event ステートメント

Function ステートメント

Property Get ステートメント

Property Let ステートメント

Property Set ステートメント

Public ステートメント

Sub ステートメント

Type ステートメント

宣言 Privateステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'プライベート変数を宣言し､メモリ領域を割り当てます｡モジュールレベルで使用します｡
'
'構文
'
'Private [WithEvents] varname[([subscripts])] [As [New] type] [,[WithEvents] varname[([subscripts])] [As [New] type]] . . .
'
'Private ステートメントの構文は､次の指定項目から構成されます｡
'
'指定項目
'WithEvents
'varname
'subscripts
'
'
'New
'type
'
'解説
'
'プライベート (Private) 変数は、宣言されたモジュール内でのみ参照できます。
'
'変数のデータ型の宣言には、Private ステートメントを使います。次の例では、変数を整数型 (Integer) で宣言しています

Private NumberOfEmployees As Integer

Private ステートメントは､変数のオブジェクトの種類の宣言にも使います｡次の例では､ワークシートの新しいインスタンスを表す変数を宣言しています｡

Private X As New Worksheet

'オブジェクト変数を宣言するときにキーワード New を指定しない場合は、オブジェクトを参照する変数を使用する前に、Set ステートメントを使用して変数に既存のオブジェクトを代入する必要があります。オブジェクト変数にオブジェクトが代入されるまで、その変数には Nothing という特殊な値が設定されます。Nothing は、その変数がオブジェクトの特定のインスタンスを参照していないことを示します。
'
'データ型やオブジェクトの種類の指定がなく、さらにモジュール内で Deftype ステートメントが記述されていない場合、変数のデータ型は既定のバリアント型 (Variant) になります。
'
'Private ステートメントで空のかっこを指定すると、動的配列を宣言できます。宣言した動的配列の次元と要素の数をプロシージャ内で定義するには、ReDim ステートメントを使います。ただし、Private ステートメント、Public ステートメント、または Dim ステートメントで明示的にサイズを指定した配列変数の次元を再び宣言しようとすると、エラーが発生します。
'
'変数の初期化時に、数値変数は 0 に、可変長文字列は長さ 0 の文字列 ("") に初期化されて、固定長文字列は 0 で埋められます。また、バリアント型の変数は Empty 値に初期化されます。ユーザー定義型変数の各要素は、個別の変数として初期化されます。
'
'メモプロシージャ内で Private ステートメントを使用する場合は、通常、Private ステートメントをプロシージャの最初に記述します。
'
'Private ステートメントの使用例
'
'次の例では、Private ステートメントをモジュールレベルで使って、変数をプライベートとして宣言しています。このような変数は、宣言を行っているモジュール内でのみ使用可能となります。

Private Number As Integer ' 整数型の変数をプライベートにします。
Private NameArray(1 To 5) As String
' 配列変数をプライベートにします。
' 1 行で複数の変数を宣言します。
' 2 つのバリアント型変数と 1 つの整数型変数がすべてプライベートになります。
Private MyVar, YourVar, ThisVar As Integer

宣言 ReDim_Preserve記述間違えが多いFor～Next文

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub ReDimPreserve()
'***************************************************************
'ReDim_Preserveの使い方(For～Next)
'***************************************************************

Dim Testi As Integer
Dim TestPreserve() As String
Dim i As Integer

i = 0 '初期化

For Testi = 1 To 10
    ReDim Preserve TestPreserve(i)
    TestPreserve(i) = Testi * 10
    i = i + 1 '<<********
Next Testi

'※For Each ～ In ～ Next ～も同じです。

'値をテストする
Dim str As String
For Testi = LBound(TestPreserve) To UBound(TestPreserve)
    str = str & Testi & vbTab & TestPreserve(Testi) & vbCr
Next Testi

MsgBox str

str = ""
Erase TestPreserve '一旦配列開放

'間違えた使い方------------------------------------
'<配列数と要素がずれてしまう例 1 >
i = 0 '初期化

For Testi = 1 To 5
    i = i + 1 '<<********
    ReDim Preserve TestPreserve(i)
    TestPreserve(i) = Testi * 10
Next Testi

For Testi = LBound(TestPreserve) To UBound(TestPreserve)
    str = str & Testi & vbTab & TestPreserve(Testi) & vbCr
Next Testi

MsgBox str
'-------------------------------------------------------------
str = ""
Erase TestPreserve '一旦配列開放

'間違えた使い方------------------------------------
'<配列数と要素がずれてしまう例 2 >

i = 0 '初期化
    ReDim Preserve TestPreserve(i) '<<********

For Testi = 1 To 5
    TestPreserve(i) = Testi * 10
    i = i + 1 '<<********
    ReDim Preserve TestPreserve(i)
Next Testi

For Testi = LBound(TestPreserve) To UBound(TestPreserve)
    str = str & Testi & vbTab & TestPreserve(Testi) & vbCr
Next Testi

MsgBox str
'-------------------------------------------------------------
End Sub

特殊・他プロシージャからVisuaruBasecEditorを起動

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub OpenVBE()
'*****************************************
'プロシージャからVisuaruBasecEditorを起動
'*****************************************
Dim strModuleName As String
strModuleName = "TestModule"
Application.VBE.MainWindow.Visible = True
ThisWorkbook.VBProject.VBComponents(strModuleName).Activate
End Sub

特殊・他ブラウザ上のインプットボックス入力(特殊なnameの場合)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub CommandButton2_Click()
    Dim objIE As Object
    Dim objIEItem As Object
    Dim i As Long

    Set objIE = Me.WebBrowser1

    For i = 1 To 47
        For Each objIEItem In objIE.Document.all
    '    Debug.Print objIEItem.tagName
            If objIEItem.tagName = "INPUT" Then
    '        MsgBox objIEItem.Name
                If objIEItem.Name = nameK(i) Then
                    objIEItem.Value = kin(i)
                    Exit For
                End If
            End If
        Next
    Next i

End Sub

特殊・他ブラウザ上のインプットボックス入力とボタンクリック操作

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Sub CommandButton1_Click()
'*********************************************************
'ブラウザ上のインプットボックス入力とボタンクリック操作
'*********************************************************
'UserForm1にWebBrowser1を設置
'UserForm1にCommandButton1を設置

Dim IE As Object, NvgtURL As String, InptTxt(2) As String
Dim InptPss As String

NvgtURL = "http://abc.ne.jp"    '該当ページURL
InptTxt(1) = "abc"              'ID等
InptTxt(2) = "def"              'ID等
InptPss = "ghij"                'PASS等

Set IE = Me.WebBrowser1

IE.Navigate NvgtURL             '該当ページ表示

IE.Visible = True

Do While IE.Busy                '表示まで待機
    DoEvents
Loop

'【例ページソース】
'<form name="GETABC">
'            ~~~~~~
'<input type="text" name="IDno1">
'                         ~~~~~
'<input type="text" name="IDno2">
'                         ~~~~~
'<input type="password" name="PWno1">
'                             ~~~~~
'<input type="submit" name="LOin">
'                           ~~~~
'</form>

IE.Document.GETABC.IDno1.Value = InptTxt(1) 'テキスト入力
'           ^^^^^^ ^^^^^
IE.Document.GETABC.IDno2.Value = InptTxt(1) 'テキスト入力
'           ^^^^^^ ^^^^^
IE.Document.GETABC.PWno1.Value = InptPss    'テキスト入力
'           ^^^^^^ ^^^^^
IE.Document.GETABC.LOin.Click               'ボタンクリック
'           ^^^^^^ ^^^^^
Do While IE.Busy                '表示まで待機
    DoEvents
Loop

Set IE = Nothing

End Sub

特殊・他その他キーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'保留イベントの制御 DoEvents
'他のプログラムの実行 AppActivate, Shell
'キーコードの転送 SendKeys
'ビープ音を鳴らす Beep
'環境変数の取得 Environ
'コマンドライン文字列の提供 Command
'オートメーションの制御 CreateObject, GetObject
'色 QBColor, RGB

特殊・他サイトマップ作成用更新頻度・優先度を返す関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'*********************************************
'サイトマップ作成用更新頻度・優先度を返す関数
'*********************************************

Function Changefreq(lebelno As Byte) As String
'****************************************
'サイトマップ作成用更新頻度を返す関数
'****************************************

Select Case lebelno
Case 1 '毎時間
Changefreq = "hourly"
Case 2 '毎日
Changefreq = "daily"
Case 3 '毎週
Changefreq = "weekly"
Case 4 '毎月
Changefreq = "monthly"
Case Else '該当なし
Changefreq = "monthly"
End Select

End Function

Function Priority(lebelno As Byte) As String
'****************************************
'サイトマップ作成用優先度を返す関数
'****************************************

Select Case lebelno
Case 1 '高
Priority = "1.0"
Case 2 '中
Priority = "0.5"
Case 3 '低
Priority = "0.0"
Case Else '該当なし
Priority = "0.0"
End Select

End Function

特殊・他チャートコントロールの設定(MSChart)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'(以下はMicrosoft Site を引用しました）
'
'◆チャートの種類の設定

MSChart1.ChartType = VtChChartType3dLine

'◆凡例の表示

MSChart1.ShowLegend = True

'◆マーカーの表示

Dim s As Series

For Each s In MSChart1.Plot.SeriesCollection
s.SeriesMarker.Show = True
Next s

'◆軸の幅､色の設定
'例: X 軸の幅､色を設定する｡

With MSChart1.Plot.Axis(VtChAxisIdX).Pen
'軸の幅を設定します。
.Width = 50
'軸の色の自動設定を解除します。
.VtColor.Automatic = False
'軸の色を設定します。
.VtColor.Set 255, 0, 0
End With

'◆軸のスケールの表示
'例: X 軸のスケールを非表示にする｡

MSChart1.Plot.Axis(VtChAxisIdX).AxisScale.Hide = True

'◆軸のスケールの設定
'
'◆X 軸のラベルの間隔､補助メモリの表示単位の設定

With MSChart1.Plot.Axis(VtChAxisIdX).CategoryScale
'自動設定を解除します。
.Auto = False
'ラベルの間隔を設定します。
.DivisionsPerLabel = 2
'補助メモリの表示単位を設定します。
.DivisionsPerTick = 2
End With

'◆Y 軸の最小値､最大値､目盛線､補助目盛線の設定

With MSChart1.Plot.Axis(VtChAxisIdY).ValueScale
'自動設定を解除します。
.Auto = False
'最大値を設定します。
.Maximum = 200
'最小値を設定します。
.Minimum = -100
'目盛線の数を設定します。
.MajorDivision = 10
'補助目盛線の数を設定します。
.MinorDivision = 10
End With

'◆目盛線のスタイル､幅､色の設定
'
'◆X 軸の目盛線の設定

With MSChart1.Plot.Axis(VtChAxisIdX).AxisGrid.MajorPen
'幅の設定をします。
.Width = 100
'スタイルの設定をします。
.Style = VtPenStyleDashDotDot
'色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 255, 0, 0
End With

'◆Y 軸の補助目盛線の設定

With MSChart1.Plot.Axis(VtChAxisIdY).AxisGrid.MinorPen
'幅を設定します。
.Width = 12
'スタイルを設定します。
.Style = VtPenStyleDashDit
'色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 255, 0, 0
End With

'◆系列のグラフの種類の変更
'例：複合グラフを作成する際の、系列 1 のグラフの種類を変更する。

'複合グラフにします。
MSChart1.ChartType = VtChChartType3dCombination
'系列タイプを 3 次元線にします。
MSChart1.Plot.SeriesCollection(1).SeriesType = VtChSeriesType3dLine

'◆系列の非表示
'例：系列 1 を非表示にする。

MSChart1.Plot.SeriesCollection(1).Position.Hidden = True

'◆系列の排除
'例：系列 1 を排除する。
MSChart1.Plot.SeriesCollection(1).Position.Excluded = True

'◆第 2Y 軸での表示
'例：系列 1 を第 2Y 軸で表示する。

MSChart1.Plot.SeriesCollection(1).SecondaryAxis = True

'◆マーカーの表示
'例：系列 1 にマーカーを表示させる。

MSChart1.Plot.SeriesCollection(1).SeriesMarker.Show = True

'◆統計線の表示
'例：系列 1 に統計線を表示する。
'
'◆系列の最小値の表示

'チャートの種類を 2D の折れ線にします。
MSChart1.ChartType = VtChChartType2dLine

With MSChart1.Plot.SeriesCollection.Item(1).StatLine
'統計線を設定します。
.Flag = VtChStatsMaximum
'線の種類を決めます。
.Style(VtChStatsMaximum) = VtPenStyleDashDitDit
'線の色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 255, 0, 0
'線の幅を設定します。
.Width = 50
End With

'◆系列の最大値の表示

'チャートの種類を 2D の折れ線にします。
MSChart1.ChartType = VtChChartType2dLine

With MSChart1.Plot.SeriesCollection.Item(1).StatLine
'統計線を設定します。
.Flag = VtChStatsMinimum
'線の種類を決めます。
.Style(VtChStatsMinimum) = VtPenStyleDitted
'線の色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 0, 0, 255
'線の幅を設定します。
.Width = 50
End With

'◆系列中の値の数学的平均の表示

'チャートの種類を 2D の折れ線にします。
MSChart1.ChartType = VtChChartType2dLine

With MSChart1.Plot.SeriesCollection.Item(1).StatLine
'統計線を設定します。
.Flag = VtChStatsMean
'線の種類を決めます。
.Style(VtChStatsMinimum) = VtPenStyleDashDotDot
'線の色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 0, 255, 255
'線の幅を設定します。
.Width = 50
End With

'◆系列中の値の標準偏差の表示

'チャートの種類を 2D の折れ線にします。
MSChart1.ChartType = VtChChartType2dLine

With MSChart1.Plot.SeriesCollection.Item(1).StatLine
'統計線を設定します。
.Flag = VtChStatsStddev
'線の種類を決めます。
.Style(VtChStatsMinimum) = VtPenStyleDashDot
'線の色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 255, 0, 255
'線の幅を設定します。
.Width = 50
End With

'◆系列の値が示すトレンド線の表示

'チャートの種類を 2D の折れ線にします。
MSChart1.ChartType = VtChChartType2dLine

With MSChart1.Plot.SeriesCollection.Item(1).StatLine
'統計線を設定します。
.Flag = VtChStatsRegression
'線の種類を決めます。
.Style(VtChStatsMinimum) = VtPenStyleNative
'線の色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 255, 255, 0
'線の幅を設定します。
.Width = 50
End With

'◆系列の内部の色､パターン､パターンの色の設定
'例：系列 1 の内部の色、パターン、パターンの色を設定する。
'
'◆系列の内部の色の設定

With MSChart1.Plot.SeriesCollection(1).DataPoints(-1).Brush
'色の自動設定を解除します。
.FillColor.Automatic = False
'色を設定します。
.FillColor.Set 0, 255, 255
End With

'◆系列内部のパターンの設定

With MSChart1.Plot.SeriesCollection(1).DataPoints(-1).Brush
'ブラシタイプを設定します。
.Style = VtBrushStylePattern
'ブラシで使用されるパターンまたはハッチングを設定します。
.Index = VtBrushPatternBoldDownDiagonal
End With

'◆系列内部のパターンの色の設定

With MSChart1.Plot.SeriesCollection(1).DataPoints(-1).Brush.PatternColor
'色の自動設定を解除します。
.Automatic = False
'色を設定します。
.Set 255, 255, 255
End With

'◆系列の線 / 縁のスタイル、幅、色の設定方法
'例：系列 1 の線 / 縁のスタイル、幅、色を設定する。
'
'◆系列の線 / 縁のスタイルの設定

MSChart1.Plot.SeriesCollection(1).DataPoints(-1).EdgePen.Style = VtPenStyleDashDotDot

'◆系列の線 / 縁の幅の設定

MSChart1.Plot.SeriesCollection(1).DataPoints(-1).EdgePen.Width = 100

'◆系列の線 / 縁の色の設定

With MSChart1.Plot.SeriesCollection(1).DataPoints(-1).EdgePen.VtColor
'色の自動設定を解除します。
.Automatic = False
'色を設定します。
.Set 255, 255, 255
End With

'◆背景の内部の色､パターン､パターンの色の設定方法
'例: チャートの背景の内部の色､パターン､パターンの色を設定する｡

With MSChart1.Backdrop.Fill
'内部の色の自動設定を解除します。
.Brush.FillColor.Automatic = False
'内部の色を設定します。
.Brush.FillColor.Set 255, 255, 255
'塗りつぶしのタイプを設定します。
.Style = VtFillStyleBrush
'ブラシタイプを設定します。
.Brush.Style = VtBrushStylePattern
'ブラシで使用されるパターンまたはハッチングを設定します。
.Brush.Index = VtBrushPatternBoldHorizontal
'パターンの色の自動設定を解除します。
.Brush.PatternColor.Automatic = False
'パターンの色を設定します。
.Brush.PatternColor.Set 0, 0, 0
End With

'タイトルの背景は、Title オブジェクト、脚注の場合は FootNote オブジェクト、
'凡例の場合は Legend オブジェクト、プロットの場合は Plot オブジェクトの下の Backdrop オブジェクトに同様な処理を行うことで設定できます。
'
'◆背景の境界線のスタイル､幅､色の設定方法
'例: 背景の境界線のスタイル､幅､色を設定する｡

With MSChart1.Backdrop.Frame
'境界線のスタイルを設定します。
.Style = VtFrameStyleSingleLine
'色の自動設定を解除します。
.FrameColor.Automatic = False
'色を設定します。
.FrameColor.Set 0, 255, 0
'幅を設定します。
.Width = 30
End With

'タイトルの背景の境界線は、Title オブジェクト、脚注の場合は FootNote オブジェクト、
'凡例の場合は Legend オブジェクト、プロットの場合は Plot オブジェクトの下の Backdrop に同様な処理を行うことで設定できます。
'
'◆チャートに影をつける方法

MSChart1.Backdrop.Shadow.Style = VtShadowStyleDrop

'◆タイトル､脚注のテキストの設定
'タイトルのテキストの設定

MSChart1.TitleText = "Title"

'脚注のタイトルは FootnoteText にテキストを設定します。
'
'◆X 軸のタイトルの設定

MSChart1.Plot.Axis(VtChAxisIdX).AxisTitle.Text = "XXXXX"

'◆タイトルの配置方向

With MSChart1.Title.TextLayout
'文字列の水平位置を設定します。
.HorzAlignment = VtHorizontalAlignmentFill
'文字列の方向を設定します。
.Orientation = VtOrientationDown
'文字列の垂直位置を設定します。
.VertAlignment = VtVerticalAlignmentTop
'文字列をワードラップするかどうかを決定する値を設定します。
.WordWrap = True
End With

'脚注は､Footnote オブジェクトに設定します｡
'
'◆X 軸のタイトルの配置方向

With MSChart1.Plot.Axis(VtChAxisIdX).AxisTitle.TextLayout
'文字列の水平位置を設定します。
.HorzAlignment = VtHorizontalAlignmentFlush
'文字列の方向を設定します。
.Orientation = VtOrientationUp
'文字列の垂直位置を設定します。
.VertAlignment = VtVerticalAlignmentBottom
'文字列をワードラップするかどうかを決定する値を設定します。
.WordWrap = True
End With

'◆フォントの設定
'例: タイトル

With MSChart1.Title.VtFont
'フォントを設定します
.Name = "ＭＳＰ明朝"
'フォントサイズを設定します
.Size = 20
'フォントにボールド属性を与えます。
.Style = VtFontStyleBold
'文字飾りを設定します。
.Effect = VtFontEffectUnderline
'色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 0, 0, 255
End With

'脚注の場合は FootNote オブジェクト、凡例の場合は Legend オブジェクトに同様の設定を行います。

'◆軸のタイトル
'例: X 軸のタイトルのフォントの設定を行う｡

With MSChart1.Plot.Axis(VtChAxisIdX).AxisTitle.VtFont
'文字飾りを設定します。
.Effect = VtFontEffectUnderline
'フォント名を設定します。
.Name = "ＭＳＰ明朝"
'フォントサイズを設定します。
.Size = 18
'スタイルを設定します。
.Style = VtFontStyleBold
'色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 255, 0, 0
End With

'◆軸のラベル
'例: X 軸のラベルのフォントの設定を行う｡

With MSChart1.Plot.Axis(VtChAxisIdX).Labels(1).VtFont
'文字飾りを設定します。
.Effect = VtFontEffectUnderline
'フォント名を設定します。
.Name = "ＭＳＰ明朝"
'フォントサイズを設定します。
.Size = 18
'スタイルを設定します。
.Style = VtFontStyleItalic
'色の自動設定を解除します。
.VtColor.Automatic = False
'色を設定します。
.VtColor.Set 0, 255, 255
End With

'◆チャートの種類 ChartType 定数
'軸の設定 AxisId 定数
'図表の線の描画 PenStyle 定数
'ブラシパターンの設定 BrushStyle 定数
'パターン、ハッチングの設定 BrushPattern 定数、BrushHatches 定数
'境界線のスタイル FrameStyle 定数
'文字列の水平位置 Orientation 定数
'文字列の方向 HorizontalAlignment 定数
'文字列の垂直位置 VerticalAlignment 定数
'フォントのスタイル FontStyle 定数
'文字の飾り FontEffect 定数
'統計線の種類 StatsType 定数

特殊・他イベント一覧UserFormユーザーフォーム

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

UserFormイベント一覧<2000>
イベント	働き（タイミング）
AddControl	フォーム、フレーム (Frame) コントロール、またはマルチページ (MultiPage) コントロールのPage オブジェクトにコントロールを挿入すると発生します｡
AfterUpdate	ユーザーの操作によって､コントロールのデータを変更した後に発生します｡
BeforeDragOver	ドラッグアンドドロップ操作の実行中に発生します。
BeforeDropOrPaste	データをオブジェクトにドロップしようとするか､または貼り付けようとすると発生します｡
BeforeUpdate	コントロールのデータを変更したときに､実際にデータが変更される前に発生します｡
Change	Value プロパティを変更したときに発生します｡
Click	次の 2 つの場合のいずれかで発生します。・マウスでコントロールをクリックしたとき。・1 つ以上の値を持つコントロールの値を正確に選択したとき。
DblClick	ユーザーがオブジェクトをポイントしながら、マウスのボタンを 2 回クリックすると発生します。
DropButtonClick	選択項目のリストをドロップダウンで表示するか､または非表示にすると発生します｡
Enter	同一フォーム上にある別のコントロールからfocusフォーカスを実際に受け取る前に発生します｡
Error	コントロールでエラーが検出され､呼び出し元のプログラムにエラー情報を返せないときに発生します｡
Exit	同一フォーム上にある別のコントロールにフォーカスを移す直前に発生します｡
KeyDown	キーを押したとき､およびキーを離したときに続いて発生します｡KeyDown イベントはキーを押すと発生します｡
KeyPress	ANSI コードまたはシフト JIS コードに対応する文字キーのいずれかを押すと発生します。
KeyUp	キーを押したとき､およびキーを離したときに続いて発生します｡KeyUp イベントはキーを離すと発生します｡
Layout	フォーム、フレーム (Frame) コントロールまたはマルチページ (MultiPage) コントロールのサイズを変更すると発生します｡
MouseDown	マウスボタンをクリックすると発生します｡マウスボタンを押したとき発生します｡
MouseMove	マウスポインタを動かすと発生します｡
MouseUp	マウスボタンをクリックすると発生します｡マウスボタンを離したときに発生します｡
RemoveControl	コントロールをコンテナから削除すると発生します｡
Scroll	スクロールバー上のスクロールボックスを動かすと発生します。
SpinDown	下向きまたは左向きのスピンボタン矢印をクリックすると発生します｡
SpinUp	上向きまたは右向きのスピンボタン矢印をクリックすると発生します｡
Zoom	Zoom プロパティの値を変更すると発生します｡

特殊・他 VBAProjectプロジェクト

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'VBAProjectプロジェクト
'    Sheetシート
'        Sheet1
'        Sheet2
'        Sheet3
'    Workbook
'    UserFormユーザーフォーム
'        UserForm1
'        UserForm2
'        UserForm3
'    Moduleモジュール
'        Module1
'            Procedureプロシージャ
'                Subプロシージャ
'                    Statementステートメント
'                        Objectオブジェクト
'                            Methodメソッド
'                            Propertyプロパティ
'                Functionプロシージャ
'                    Statementステートメント
'                Propertyプロシージャ
'                    Statementステートメント
'        Module2
'        Module3
'    Classクラス
'        Class1
'        Class2
'        Class3

特殊・他 NewSearchメソッドの使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の使用例は､NewSearch メソッドを使用して検索条件を既定の設定にリセットした後､新しい検索を開始します｡

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .Filename = "run"
    .TextOrProperty = "San*"
    .MatchAllWordForms = True
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
        MsgBox .FoundFiles.Count & _
        " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

特殊・他 VB6系では実行中のプロシージャ名を取得することは出来ません

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'実行中のプロシージャ名を取得することは､VB6系ではありません。エラー処理などの利用の場合、プロシージャ名をプロシージャ内に記述するほかありません。

'VB.NETでは「StackTrace」クラスで取得可能です。

特殊・他クラスモジュール初歩的記述

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit
'クラスモジュールに「C_TestName」というオブジェクト名をつけて下記を記述します。
Function ThisName(bytNo As Byte) As String
Select Case bytNo
Case 1
ThisName = "一郎"
Case 2
ThisName = "二郎"
Case 3
ThisName = "三郎"
Case 4
ThisName = "四郎"
Case 5
ThisName = "五郎"
Case 6
ThisName = "六郎"
Case 7
ThisName = "七郎"
Case Else
ThisName = "花子"
End Select
End Function

------------------------------------------
Option Explicit
'標準モジュールに「M_ClassTest」というオブジェクト名をつけて下記を記述します。
Sub ClassTest()
Dim Test1 As New C_TestName
Dim a As Byte

a = CByte(InputBox("Name NO?", "as Byte", 0))

MsgBox Test1.ThisName(a), 0, "ANS"
End Sub
'上記「ClassTest」を実行してみてください。

特殊・他イベント一覧Workbookワークブック

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Workbookイベント一覧<2000>
イベント		対象	働き（タイミング）
Workbook	Activate	ブック	アクティブになったら発生
	AddinInstall		アドインとして組み込まれたら発生
	AddinnUninstall		アドインから解除されたら発生
	BeforeClose		閉じられる前
	BeforePrint		印刷される前
	BeforeSave		保存される前
	Deactive		アクティブでなくなったら発生
	NewSheet		新規シートを追加されたら発生
	Open		開かれたら発生
	SheetActive	シート	アクティブになったら発生
	SheetBeforeDoubleClick		ダブルクリックされたら発生
	SheetBeforeRightClick		右クリックされたら発生
	SheetCalculate		再計算されたら発生
	SheetChange		セルの値が変更されたら発生
	SheetDeactive		アクティブでなくなったら発生
	SheetFollowHyperlink		ハイパーリンクをクリックしたら発生
	SheetSelectionChange		セルの選択範囲が変更されたら発生
	WindowActivate	ウインドウ	アクティブになったら発生
	WindowDeactivate		アクティブでなくなったら発生
	WindowResize		大きさが変更されたら発生

特殊・他コレクションオブジェクトに関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'コレクションの作成 Collection
'コレクションへのオブジェクトの追加 Add
'コレクションからのオブジェクトの解放 Remove
'コレクションの項目の参照 Item

特殊・他大量のプロシージャー(マクロ)を実行する-Loop-同じプロジェクトの場合

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub LargeProcedurePractice1()
'*********************************************
'大量のプロシージャー(マクロ)を実行する-Loop
'*********************************************
'同じプロジェクトの場合
'文字String型にして実行

Dim strModule As String
Dim strProcedure As String
Dim strPractice As String
Dim i As Long

strModule = "Module4" 'モジュール名
strProcedure = "MsgboxTest" 'プロシージャー名

For i = 1 To 4

strPractice = strModule & "." & strProcedure & i

Run strPractice

Next i

End Sub

'以下モジュール名（オブジェクト名）「Module4」に記述
'※同じプロジェクト内
Sub MsgboxTest1()
MsgBox "Test1"
End Sub

Sub MsgboxTest2()
MsgBox "Test2"
End Sub

Sub MsgboxTest3()
MsgBox "Test3"
End Sub

Sub MsgboxTest4()
MsgBox "Test4"
End Sub

特殊・他消費税取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Function Fnc消費税(Kingaku As Long) As Long
'*******************************************************************************
'消費税取得
'*******************************************************************************
Dim Zeiritsu As Double
Zeiritsu = 0.05
Fnc消費税 = Int(Kingaku * Zeiritsu)
End Function

特殊・他大量のプロシージャー(マクロ)を実行する-Loop-違うプロジェクトの場合]

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub LargeProcedurePractice2()
'*********************************************
'大量のプロシージャー(マクロ)を実行する-Loop
'*********************************************
'違うプロジェクトの場合(起動済み要)
'文字String型にして実行

Dim strProject As String
Dim strModule As String
Dim strProcedure As String
Dim strPractice As String
Dim i As Long

strProject = "Project1.xls" 'プロジェクト名(ファイル名)
strModule = "Module5" 'モジュール名
strProcedure = "MsgboxTest" 'プロシージャー名

For i = 1 To 4

strPractice = strProject & "!" & strModule & "." & strProcedure & i

Run strPractice

Next i

End Sub

'以下モジュール名（オブジェクト名）「Module5」に記述
'※同じプロジェクト内
Sub MsgboxTest1()
MsgBox "Test5"
End Sub

Sub MsgboxTest2()
MsgBox "Test6"
End Sub

Sub MsgboxTest3()
MsgBox "Test7"
End Sub

Sub MsgboxTest4()
MsgBox "Test8"
End Sub

特殊・他奇数か偶数かを判別する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function fKi_Gusuu(Target) As Boolean
'**************************************
'変数 Target が、奇数か偶数かを判別する
'**************************************
'返値は偶数=True、奇数=False

If Target Mod 2 = 0 Then
fKi_Gusuu = True
Else
fKi_Gusuu = False
End If

'【Mod 演算子】
'2 つの数値の除算を行い､その剰余を返します｡
'
'result = number1 Mod number2
'
'剰余演算子は、数式 number1 を数式 number2 で除算し、その余りを演算結果 result として返します。
'このとき浮動小数点数は整数に丸められます。
'次に示す式では、変数 A (演算結果 result) の値は 5 になります。
'
'A = 19 Mod 6.7
'
'一方または両方の式が Null 値のときは、演算結果 result も Null 値になります。
'Empty 値を持つ式は、0 として扱われます。

End Function

特殊・他引数を省略出来るステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub OptionalTest()
'********************************
'引数を省略出来るステートメント
'********************************

MsgBox test1("CCC", "BBB")

MsgBox test2("CCC")

MsgBox test3()

MsgBox test3("BBB")

'Optional str2 As String = "BBB"
'str2が省略された場合はstr2は"BBB"とする

'【使用可能ステートメント】
'Declare ステートメント
'
'Function ステートメント()
'
'Property Get ステートメント()
'
'Property Let ステートメント
'
'Property Set ステートメント
'
'Sub ステートメント()

End Sub

Private Function test1(str1 As String, str2 As String, Optional str3 As String = "AAA") As String
    If str3 = "AAA" Then
        test1 = "YES!"
    Else
        test1 = "NO!"
    End If
End Function

Private Function test2(str1 As String, Optional str2 As String = "BBB", Optional str3 As String = "AAA") As String
    If str2 = "BBB" And str3 = "AAA" Then
        test2 = "YES!"
    Else
        test2 = "NO!"
    End If
End Function

Private Function test3(Optional str3 As String = "CCC") As String
    If str3 = "CCC" Then
        test3 = "YES!"
    Else
        test3 = "NO!"
    End If
End Function

特殊・他住所から郵便番号を取得するAddress-Zip

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fncGetZip(住所 As String, CSVFaliPath As String) As String
'*******************************************************************************
'住所から郵便番号を取得する Address-Zip
'*******************************************************************************
'引数：住所＝郵便番号を探す住所
'引数：CSVFaliPath＝ＣＳＶファイルのあるルートパス
'ＣＳＶファイルは
'読み仮名データの促音・拗音を小書きで表記したもの（例：ホッカイドウ)を使用
'http://www.post.japanpost.jp/zipcode/dl/kogaki.html
'より入手

Application.ScreenUpdating = False

Dim CSVファイル As Workbook, CSVシート As Worksheet
Dim a As String, b As String, c As Long, d As Long
Dim 連住所 As String, 決定 As String
a = Dir(CSVFaliPath): b = Mid(a, 1, Len(a) - 4)
psbブックを開く CSVFaliPath
Set CSVファイル = Workbooks(a)
Set CSVシート = CSVファイル.Worksheets(b)

With CSVシート
    c = .Range("a65536").End(xlUp).Row
    決定 = ""
        For d = 1 To c
            連住所 = .Cells(d, 8).Value & .Cells(d, 9).Value
                If InStr(1, 住所, 連住所) <> 0 Then
                    決定 = .Cells(d, 3).Value
                    Exit For
                End If
        Next d
End With

If 決定 = "" Then
    With CSVシート
        c = .Range("a65536").End(xlUp).Row
        決定 = ""
            For d = 1 To c
                連住所 = .Cells(d, 8).Value & "大字" & .Cells(d, 9).Value
                    If InStr(1, 住所, 連住所) <> 0 Then
                        決定 = .Cells(d, 3).Value
                        Exit For
                    End If
            Next d
    End With
End If

If 決定 = "" Then
MsgBox "指定ファイル内に指定住所の郵便番号は見つかりませんでした。", vbCritical, "郵便番号検索"
fncGetZip = 0
Else
fncGetZip = 決定
End If
CSVファイル.Close
Set CSVファイル = Nothing
Set CSVシート = Nothing

'35YAMAGU
End Function

日付時刻 VBやVBAで使用するDate関数やTime関数をUNIX(ユニックス)タイムにする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function UnixDateConversion(dblDate As Double) As Date
'**************************************************************
'ユニックスタイムをVBやVBAで使用するDate関数やTime関数にする
'**************************************************************
'"yyyy/mm/dd hh:mm:ss"の書式で表される値を返します。
UnixDateConversion = ((dblDate + 32400) / 86400) + 25569
'解説は下test2
End Function

Function DateUnixConversion(dblDate As Date) As Double
'**************************************************************
'VBやVBAで使用するDate関数やTime関数をユニックスタイムにする
'**************************************************************
'UNIX形式に変換(UNIXタイムスタンプ)
DateUnixConversion = DateDiff("s", "1970/01/01 00:00:00", dblDate) - 32400
'解説は下test2
End Function

Private Sub test()
MsgBox UnixDateConversion("1260751469")
End Sub

Private Sub test1()
MsgBox DateUnixConversion("2009/12/14 09:44:29")
End Sub

Private Sub test2()
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'求め方
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'①ユニックスタイム
'   Unix time 1970/01/01 00:00:00 からの通算秒数
'②VBやVBAで使用するDate関数やTime関数
    Debug.Print Format(CDate(0), "yyyy/mm/dd hh:nn:ss")
    'Ａ　1899/12/30 00:00:00
'③それぞれの日数差を求めます。【DateDiff 関数】
    Debug.Print DateDiff("d", "1970/01/01 00:00:00", "1899/12/30 00:00:00")
    Debug.Print CLng(CDate("1970/01/01 00:00:00"))
    'Ａ　-25569　（日）
'④時差は9時間これを秒数にする。
'    a = 9 * 60 * 60
    'Ａ　32400　（秒）
'⑤1日(24時間)の秒数を求めます。
'    a = 24 * 60 * 60
    'Ａ　86400　（秒）

'【VBやVBAで使用するDate関数やTime関数をユニックスタイムにする式は】
    '例"2009/12/14 09:44:29"の場合
    Dim i As Date
    i = "2009/12/14 09:44:29"

    MsgBox DateDiff("s", "1970/01/01 00:00:00", i) - 32400
    'Ａ 1260751469　になる

'【ユニックスタイムをVBやVBAで使用するDate関数やTime関数にする式は】
    Dim j As Double
    j = 1260751469

    MsgBox CDate(((j + 32400) / 86400) + 25569)
    'Ａ "2009/12/14 09:44:29"　になる

End Sub

Private Sub test3()
'============================================================
'【DateDiff 関数】
'============================================================
'2 つの指定した日付の時間間隔を表す値を返します。
MsgBox DateDiff("m", "2008/12/12", "2009/12/12")
'~~~~~~~~~~~~~~~~①~~~~~~~②~~~~~~~~~~~~③~~~~

'①下記の「文字列式」より選択
'②基準になる日時を指定(起算値)
'③算出の対象となる日時
MsgBox DateDiff("m", "2009/12/12", "2008/12/12")
'マイナスの場合は過去になる

'============================================================
'【DateAdd 関数】
'============================================================
'指定された時間間隔を加算した日付を返します。
MsgBox DateAdd("m", 1, Date)
'~~~~~~~~~~~~~~~①~~②~~③~~~~

'①下記の「文字列式」より選択
'②、①に対して将来の日時を求める場合正の値(+)、過去の場合は負の値(-)
'③基準になる日時を指定

'============================================================
'【DatePart 関数】
'============================================================
'日付の指定した部分を含む値を返します。
MsgBox DatePart("h", Now)
'~~~~~~~~~~~~~~~~①~~②~~
'①下記の「文字列式」より選択
'②基準になる日時を指定
MsgBox Format(Now, "h")
'でも同じ値が求められます。

'============================================================

'************
'* 文字列式
'************
'-----------------------------------
'   設定値内容
'-----------------------------------
'   yyyy    年
'   q       四半期
'   m       月
'   y       年間通算日
'   d       日
'   w       週日
'   ww      週
'   h       時
'   n       分
'   s       秒

End Sub

特殊・他郵便番号から住所を取得するZip-Address

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fncGetAddress(郵便番号 As String, CSVFaliPath As String) As String
'*******************************************************************************
'郵便番号から住所を取得する Zip-Address
'*******************************************************************************
'引数：郵便番号＝住所を探す郵便番号
'引数：CSVFaliPath＝ＣＳＶファイルのあるルートパス
'ＣＳＶファイルは
'読み仮名データの促音・拗音を小書きで表記したもの（例：ホッカイドウ)を使用
'http://www.post.japanpost.jp/zipcode/dl/kogaki.html
'より入手

Application.ScreenUpdating = False

Dim CSVファイル As Workbook, CSVシート As Worksheet
Dim a As String, b As String, c As Long, d As Long, e(5) As String, f As Byte
Dim 連住所 As String, 決定 As String
a = Dir(CSVFaliPath): b = Mid(a, 1, Len(a) - 4)
psbブックを開く CSVFaliPath
Set CSVファイル = Workbooks(a)
Set CSVシート = CSVファイル.Worksheets(b)

'郵便番号を必要形式に変える
'1.小文字変換
e(1) = StrConv(Trim(郵便番号), vbLowerCase)
e(3) = ""
    For f = 1 To Len(e(1))
        e(2) = Mid(e(1), f, 1)
            If IsNumeric(e(2)) = True Then
                e(3) = e(3) & e(2)
            End If
    Next f
'2.７桁か？
If Len(e(3)) <> 7 Then
決定 = ""
MsgBox "郵便番号形式が７桁ではありません。", vbCritical, "郵便番号形式エラー"
GoTo myend:
End If

With CSVシート
    c = .Range("a65536").End(xlUp).Row
    決定 = ""
        For d = 1 To c
            If e(3) = .Cells(d, 3).Value Then
                連住所 = .Cells(d, 7).Value & .Cells(d, 8).Value & .Cells(d, 9).Value
                決定 = 連住所
            End If
        Next d
End With

myend:
If 決定 = "" Then
MsgBox "指定ファイル内に指定郵便番号の住所は見つかりませんでした。", vbCritical, "住所検索"
fncGetAddress = 0
Else
fncGetAddress = 決定
End If
CSVファイル.Close
Set CSVファイル = Nothing
Set CSVシート = Nothing

'35YAMAGU
End Function

日付時刻時間関数の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の例は、Hour 関数を使って、指定された時刻の "時" で表される部分を取得します。開発環境時には、時刻リテラルはコード記述時の国別情報で設定されている短い時刻の形式で表示されます。

Dim MyTime, MyHour
MyTime = #4:35:17 PM# ' 時刻を代入します。
MyHour = Hour(MyTime) ' MyHour には、16 が代入されます。

'次の例は、Minute 関数を使って、指定された時刻の "分" で表される部分を取得します。開発環境時には、時刻リテラルはコード記述時の国別情報で設定されている短い時刻の形式で表示されます。

Dim MyTime, MyMinute
MyTime = #4:35:17 PM# ' 時刻を代入します。
MyMinute = Minute(MyTime) ' MyMinute には、35 が代入されます。

'次の例は、Second 関数を使って、指定された時刻の "秒" で表される部分を取得します。開発環境時には、時刻リテラルはコード記述時の国別情報で設定されている短い時刻の形式で表示されます。

Dim MyTime, MySecond
MyTime = #4:35:17 PM# ' 時刻を代入します。
MySecond = Second(MyTime) ' MySecond には、17 が代入されます。

日付時刻現在の日付と時刻から文字列作成

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function DateTimeName() As String
'*********************************
'現在の日付と時刻から文字列作成
'*********************************
'ファイル名やフォルダ名に使用する場合など
'１４文字(yyyymmddhhnnss)で返します。
'年年年年月月日日時時分分秒秒

'20100101230101
DateTimeName = Format(Date, "yyyymmdd") & Format(time, "hhnnss")

'20100101_230101
DateTimeName = Format(Date, "yyyymmdd") & "_" & Format(time, "hhnnss")

End Function

日付時刻月末を求める

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fnc月末(HIDUKE As Date) As String
'*******************************************************************************
'月末を求める
'*******************************************************************************
Dim a As Date
a = DateAdd("m", 1, DateSerial(Year(HIDUKE), Month(HIDUKE), 1))
fnc月末 = CDate(a - 1)
End Function

日付時刻時間日付に関するフォーマット

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'*******************************************************************************
'日付を取得【Year(Date)】
'*******************************************************************************
'Year (日付)
'Month (日付)
'Day (日付)

'*******************************************************************************
'日付の表示書式【Format】
'*******************************************************************************
'Long Date      [2004年5月3日]  形式表示
'Medium Date    [03・Apr・98]   形式表示
'Short Date     [98/11/23]      形式表示
'Long Time      [10：14：42PM]  形式表示
'Medium Time    [10：45PM]      形式表示
'Short Time     [19：32]        形式表示
'General Date   日付だけの場合は時刻は表示されません。
'               時刻だけの場合は日付は表示されません。

'*******************************************************************************
'日付の表示書式【Format】
'*******************************************************************************
'/      日付の区切り記号を表示
'c      既存の書式名[General Date/日付（標準）]と同じ
'd      1～31で日付を表示
'dd     01～31で日付を表示
'ddd    曜日を省略形（英語３文字）で表示（Sun～Sat）
'aaa    曜日を省略形（日本語）で表示（日～土）
'dddd   曜日を英語で表示（Sunday～Saturday）
'aaaa   曜日を日本語で表示（日曜日～土曜日）
'ddddd  既存の書式名[Short Date/日付（S）]と同じ
'dddddd 既存の書式名[Long Date/日付（L）]と同じ
'w      曜日を数値で表示（1～7）
'ww     その日が１年のうちの何週目であるかを表示（1～53）
'm      1～12で月を表示
'mm     01～12で月を表示
'mmm    月の名前を省略形（英語３文字）で表示（Jan～Dec）
'mmmm   月の名前（英語）を省略せずに表示
'q      １年のうちどの四半期に属するかを表示（1～4）
'g      年号の頭文字を表示(M, t, s, h)
'gg     年号の先頭の1文字を漢字で表示(明, 大, 昭, 平)
'ggg    年号を表示(明治, 大正, 昭和, 平成)
'e      年を年号で表示
'ee     年を年号で2桁の数値で表示
'y      日付を1月1日からの日数で表示（1～366）
'yy     西暦の最後の２桁を表示（01～99）
'yyyy   西暦を表示（0100～9999)

'*******************************************************************************
'時刻を取得【Second (Time)】
'*******************************************************************************
'Hour (Time)
'Minute (Time)
'Second (Time)

'*******************************************************************************
'時刻の表示書式【Format】
'*******************************************************************************
'：     (コロン）時刻の区切り記号を表示
'h      0～23で時刻を表示
'hh     00～23（2桁）で時刻を表示
'n      0～59で分を表示
'nn     00～59（2桁）で分を表示
's      0～59で秒を表示
'ss     00～59（2桁）で秒を表示
'ttttt  定義済み書式"Long Time"と同じ
'AM/PM  大文字のAM,PMを付加して12時間制で時刻を表示
'am/pm  小文字のam,pmを付加して12時間制で時刻を表示
'A/P    大文字のA,Pを付加して12時間制で時刻を表示
'a/p    小文字のa,pを付加して12時間制で時刻を表示

シートシート新ブック保存

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Sub シート新ブック保存(TagetBook As Workbook, TagetSheet As Worksheet, FolPath As String, ファイル名 As String)
'*******************************************************************************
'指定シートを新しいブックに保存（指定フォルダへ）必ずシート名は[Sheet1]にする
'*******************************************************************************
Dim NewBook As Workbook, strName As String, NewSheet As Worksheet

strName = 保存名作成

Set NewBook = Workbooks.Add
    Dim i, cnt As Integer
    cnt = NewBook.Sheets.Count
    For i = 1 To cnt
        If NewBook.Sheets(i).Name = "Sheet1" Then
            NewBook.Sheets(i).Name = "Sheet0"
            Exit For
        End If
    Next

    TagetSheet.Copy Before:=NewBook.Sheets(1)
Set NewSheet = NewBook.Sheets(1)
    NewSheet.Name = "Sheet1"
    Call シート削除(NewBook, "Sheet0")
'    MsgBox FolPath & "\" & ファイル名 & "_" & strName & ".xls"
'    MsgBox InputBox("", "", FolPath & "\" & ファイル名 & "_" & strName & ".xls")
'    NewBook.SaveAs Filename:= _
'        FolPath & "\" & ファイル名 & "_" & strName & ".xls" ', FileFormat:= _
'        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
'        , CreateBackup:=False
    NewBook.SaveAs Filename:=FolPath & "\" & ファイル名 & "_" & strName & ".xls"
    NewBook.Close
Set NewSheet = Nothing
Set NewBook = Nothing
MsgBox "保存完了しました。", vbInformation, "保存完了"

End Sub

シートシート上のURLのソースを取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub SheetHTMLsourceGet()
'****************************
'シート上のURLのソースを取得
'****************************
'即興で作成
'少しコードが荒いです
'適当に変換して使って下さい。
Dim sht As Worksheet
Dim n As Long, tmp(4) As String, i As Long
Dim Character As String, SPL As Variant, SP(4) As String
Dim Ffind(24) As String, Lfind(24) As String, SPL2 As Variant

Set sht = ThisWorkbook.Worksheets("Sheet2")

Ffind(11) = "<title>"
Lfind(12) = "</title>"
Ffind(13) = "<div class=""適当な文字"">"
Lfind(14) = "<div class=""適当な文字"">"
SP(1) = "<div>"
SP(2) = "<"

With sht
For n = 1 To .Cells(65536, 1).End(xlUp).Row

    Character = responseXMLText(.Cells(n, 1).Value)
        tmp(1) = CharacterFindNext(Character, Ffind(11), Lfind(12))
        Debug.Print tmp(1)
        .Cells(n, 3).Value = tmp(1)
        tmp(2) = CharacterFindNext(Character, Ffind(13), Lfind(14))
        Debug.Print tmp(2)
        SPL = Split(tmp(2), SP(1))
        For i = LBound(SPL) To UBound(SPL)
        SPL2 = Split(Trim(SPL(i)), SP(2))
        Debug.Print SPL2(0)
        .Cells(n, i + 4).Value = SPL2(0)
        Next i

Next n
End With
MsgBox "END!"
End Sub

Private Sub GetMSXML(ByRef objMSXML As Object, ByRef blnErr As Boolean)
'***************************************************
'XML_Parser(MSXML)をObject定義する
'***************************************************
'リロードを伴わずにソース情報取得
'元々はXML形式のデータのやり取りを行うもの
'XML Parser
'JavaScriptではAjax(Asynchronous JavaScript + XML)

On Error Resume Next
    Set objMSXML = CreateObject("MSXML2.XMLHTTP") 'MSXML2Class
    If (Err.Number <> 0) Then
        Set objMSXML = CreateObject("Microsoft.XMLHTTP")
            If (Err.Number <> 0) Then
                Set objMSXML = CreateObject("MSXML.XMLHTTPRequest")
            End If
    End If

On Error GoTo 0
    If objMSXML Is Nothing Then
        blnErr = True
    Else
        blnErr = False
    End If

End Sub

Private Function responseXMLText(strURL As String) As String
'*********************************************
'XML又はTextで取得する
'*********************************************
'*********************************************
'Shift -JISをUnicodeに変換
'*********************************************

Dim objMSXML As Object, blnErr As Boolean
'Dim strURL As String
Dim lngStatus As Long, strStatus As String, strSRC As String
Dim XMLTXT As Byte, blnSJIS As Boolean

'パラメータ
'strURL = "http://www.yahoo.co.jp/"

'パラメータ
'XMLデータ(responseXML) = 0
'TXTデータ(responseText) = 1
XMLTXT = 1

'パラメータ
'Shift-JIS  の場合 = True
'Unicode    の場合 = False
blnSJIS = False

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Function

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .ReadyState <> 4 Then
        DoEvents
        GoTo reTry:
    End If

    lngStatus = .Status
    strStatus = .StatusText
    If (.Status < 200 Or .Status >= 300) Then
        Debug.Print lngStatus & vbTab & strStatus
        Exit Function
    Else
        Debug.Print lngStatus & vbTab & strStatus
    End If

    If XMLTXT = 0 Then
        'XML形式以外はエラーになります。
        strSRC = .responseXML
    Else
        strSRC = .responseText
    End If

    If blnSJIS = True Then
        strSRC = StrConv(.responseBody, vbUnicode)
    Else
        strSRC = .responseText
    End If

'    Debug.Print strSRC
    responseXMLText = strSRC
End With

End Function

シートシート上のハイパーリンクを取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub HyperlinkGet()
'***********************************
'シート上のハイパーリンクを取得する
'***********************************
'A列にあるものと仮定しています
'E列に取得結果を表示してます
'リンクが無い場合はOn Errorで回避してます

Dim i As Long, Sht As Worksheet

Set Sht = ThisWorkbook.Worksheets("Sheet1")

On Error Resume Next

    With Sht
        For i = 1 To .Cells(65536, 1).End(xlUp).Row
            .Cells(i, 5).Value = .Cells(i, 1).Hyperlinks(1).Address
        Next i
    End With

End Sub

シートオブジェクトがクリックされたときに実行するマクロ

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の使用例は、図形 1 をクリックしたときに、ShapeClick プロシージャを実行するようにします。

Worksheets(1).Shapes(1).OnAction = "ShapeClick"

シートエクセルVBAワークシートの名前・数・追加・移動・削除・コピー・非表示

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'ExcelSheet
'エクセルワークシートの操作全般
'   ・シート名             (Name)　取得・変更
'   ・シート数             (Count)
'   ・シートの追加         (Add)
'   ・シートの移動         (Move)
'   ・シートの削除         (Delete)
'   ・シートのコピー       (Copy)
'   ・シートの表示と非表示 (Visible)

Sub ExcelSheetAllName()
'*****************************************
'指定ブックにある全てのシート名を取得する
'*****************************************

Dim bok As Workbook, sht As Worksheet
Dim strMSG As String, i As Long

Set bok = ThisWorkbook

Application.ScreenUpdating = False
i = 0
    For Each sht In bok.Worksheets
        With sht
           i = i + 1
           strMSG = strMSG & i & vbTab & .Name & vbCr

        End With
    Next sht
Application.ScreenUpdating = True

MsgBox strMSG

End Sub

Sub ExcelSheetAllNameChange()
'*****************************************
'指定ブックにある全てのシート名を変更する
'*****************************************

Dim bok As Workbook, sht As Worksheet
Dim strMSG As String, i As Long

Set bok = ThisWorkbook

Application.ScreenUpdating = False
i = 0
    For Each sht In bok.Worksheets
        With sht
           i = i + 1
           .Name = "シート" & i

        End With
    Next sht
Application.ScreenUpdating = True

MsgBox "END"

End Sub

Sub ExcelSheetAllCount()
'***********************************************
'指定ブックにある全てのシートの数をカウントする
'***********************************************

Dim bok As Workbook

Set bok = ThisWorkbook

MsgBox "シート数" & vbTab & bok.Sheets.Count

End Sub

Sub ExcelSheetAdd()
'***********************************************
'指定ブックのシートを追加する
'***********************************************

Dim bok As Workbook, sht As Worksheet

Set bok = ThisWorkbook
Set sht = bok.Sheets.Add

MsgBox "追加シート" & vbTab & sht.Name

End Sub

Sub ExcelSheetAddCount()
'***********************************************
'指定ブックのシートを複数追加する
'***********************************************

Dim bok As Workbook, bytCnt As Byte

bytCnt = 3

Set bok = ThisWorkbook

bok.Worksheets.Add Count:=bytCnt

MsgBox "追加シート" & vbTab & bytCnt

End Sub

Sub ExcelSheetAddAfter()
'*************************************************
'指定ブックのシートを最後(追加場所指定)に追加する
'*************************************************

Dim bok As Workbook, bytCnt As Byte

bytCnt = 2

Set bok = ThisWorkbook

With bok
.Worksheets.Add After:=.Worksheets(.Worksheets.Count), Count:=bytCnt
End With

MsgBox "最後に追加シート" & vbTab & bytCnt

End Sub

Sub ExcelSheetAddBeforeName()
'*****************************************************
'指定ブックのシートを名前と追加場所を指定して追加する
'*****************************************************
'シート群の最初に名前を指定して追加
'同名シートは追加不可です。

Dim bok As Workbook

Set bok = ThisWorkbook

With bok
.Worksheets.Add(Before:=.Worksheets(1)).Name = "テスト前"
End With

MsgBox "END"

End Sub

Sub ExcelSheetAddAppName()
'*****************************************************
'指定ブックのシートを名前と追加場所を指定して追加する
'*****************************************************
'指定シートの前に名前を指定して追加
'同名シートは追加不可です。

Dim bok As Workbook

Set bok = ThisWorkbook

With bok
.Worksheets.Add(Before:=.Worksheets("Sheet11")).Name = "横"
End With

MsgBox "END"

End Sub

Sub ExcelSheetMoveAfter()
'*****************************************************
'指定ブックのシートを移動する
'*****************************************************
'指定シートを指定シートの後に移動

Dim bok As Workbook

Set bok = ThisWorkbook

With bok
.Worksheets("横").Move After:=.Worksheets("テスト")
End With

MsgBox "END"

End Sub

Sub ExcelSheetDelete()
'*****************************************************
'指定ブックの指定シートを削除する
'*****************************************************
'全てのシートは削除不可(最低１枚は必要)
'以下の例はシート名に「Sheet」がつくシートを全て削除してます。

Dim bok As Workbook, sht As Worksheet

Set bok = ThisWorkbook

Application.ScreenUpdating = False

    For Each sht In bok.Worksheets
        With sht
           If InStr(1, .Name, "Sheet") <> 0 Then
                'ダイアログ非表示
                Application.DisplayAlerts = False
                .Delete
                'ダイアログ表示
                Application.DisplayAlerts = True
           End If
        End With
    Next sht

Application.ScreenUpdating = True

MsgBox "END"

End Sub

Sub ExcelSheetCopy()
'*****************************************************
'指定ブックの指定シートをコピーする
'*****************************************************
'新しくブックを追加して指定シートの後にコピー

Dim bok As Workbook, bok2 As Workbook

Set bok = ThisWorkbook
Set bok2 = Workbooks.Add

bok.Worksheets("テスト").Copy After:=bok2.Worksheets("Sheet1")

MsgBox "END"

End Sub

Sub ExcelSheetVisibleFalse()
'*****************************************************
'指定ブックの指定シートを隠す(非表示)
'*****************************************************
'メニューから表示可能

Dim bok As Workbook

Set bok = ThisWorkbook

bok.Worksheets("テスト").Visible = False

MsgBox "END"

End Sub

Sub ExcelSheetVisibleTrue()
'*****************************************************
'指定ブックの指定シートを表示(再表示)
'*****************************************************

Dim bok As Workbook

Set bok = ThisWorkbook

bok.Worksheets("テスト").Visible = xlSheetVisible 'True'でも可(xlSheetVisible)

MsgBox "END"

End Sub

Sub ExcelSheetHidden()
'*****************************************************
'指定ブックの指定シートを隠す(非表示)
'*****************************************************
'メニューから表示可能

Dim bok As Workbook

Set bok = ThisWorkbook

bok.Worksheets("テスト").Visible = xlSheetHidden

MsgBox "END"

End Sub

Sub ExcelSheetVeryHidden()
'*****************************************************
'指定ブックの指定シートを隠す(非表示)
'*****************************************************
'メニューから表示不可(VBAからのみ可能)

Dim bok As Workbook

Set bok = ThisWorkbook

bok.Worksheets("テスト").Visible = xlSheetVeryHidden

MsgBox "END"

End Sub

シートシートに名前をつけて追加する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub gg()

Sheet1.Name = "1月"
Dim x, y
For x = 2 To 12
y = x & "月"
Sheet1.Activate
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = y
Next x

End Sub

コントロールリストボックスのデータ参照

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Me.ListBox3.RowSource = "[Data.xls]Sheet1 A1:A" & lngRow
'’又は
Me.ListBox3.List = Workbooks("Data.xls").Worksheets("Sheet1").Range("A1:A" & lngRow).Value

コントロールラベルに処理状況を一定間隔で表示

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Dim bytLabelstr As Byte
Dim objME As Object
Dim MeMax As Long
Dim MeNow As Long
MeMax = Suu
MeNow = ForSuu
Set objME = Me.Label12
bytLabelstr = bytLabelstr + 1
If bytLabelstr = 40 Then
bytLabelstr = 0
End If
If bytLabelstr <= 20 Then
objME.Caption = ""
DoEvents
Else
objME.Caption = "Just a moment "
DoEvents
End If
If MeNow = MeMax Then objME.Caption = ""
Set objME = Nothing

コントロールリストコンボボックス時刻を３０分毎すすめた表示をする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

d = TimeSerial(8, 0, 0)
For c = 1 To 20
d = TimeSerial(8, c * 30, 0)
.ComboBox4.AddItem Format(d, "hh:mm")
Next c

コントロールリストボックスを複数選択

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Dim i As Long
With Me.ListBox1
.ColumnCount = 3
For i = 2 To 100
.AddItem
.List(.ListCount - 1, 0) = sht名簿.Cells(i, 1)
.List(.ListCount - 1, 1) = sht名簿.Cells(i, 2)
.List(.ListCount - 1, 2) = sht名簿.Cells(i, 26)
Next i
End With
Me.ListBox1.ListIndex = -1

コントロールリストボックスの見出し

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub UserForm_Initialize()

    With ListBox1
        .ColumnHeads = True
'Ａ列が見出し自動判別
        .RowSource = sht.Range("a2", sht.Range("a65536").End(xlUp)).Address
    End With

End Sub

コントロールリストボックス見出し表示

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

    .ListBox1.ColumnCount = 4
    .ListBox1.ColumnHeads = True
    .ListBox1.RowSource = "[pdpData.xls]カルテ A2:d" & lngDatasuu2

エラー Errオブジェクト-Clear・Raiseメソッド

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Clear メソッド
Err オブジェクトのすべてのプロパティの設定値をクリアします。
構文
object.Clear
object には、Err オブジェクトへの参照を表すオブジェクト式を指定します。
解説
Clear メソッドを使うと、エラーを処理した後で Err オブジェクトを明示的にクリアすることができます。
たとえば、On Error Resume Next ステートメントを使用した後でエラー処理を行うときなどです。
次のいずれかのステートメントが実行されると、Clear メソッドが自動的に呼び出されます。
- 任意の Resume ステートメント
- Exit Sub ステートメント、
- Exit Function ステートメント
- Exit Property ステートメント
- 任意の On Error ステートメント
メモ
他のオブジェクトへのアクセス中に発生するエラーを処理するときには、On Error GoTo ステートメントよりも On Error Resume Next ステートメントの方が適しています。オブジェクトに対してアクセスするたびに Err オブジェクトの値を確認すると、エラーの発生時にコードがどのオブジェクトにアクセスしていたかが明確になります。
どのオブジェクトが Err オブジェクトの Number プロパティにエラー番号を設定したか、およびどのオブジェクトが最初にエラーを発生させたか (Err オブジェクトの Source プロパティに指定されるオブジェクト) を確認できます。
Clear メソッドの使用例
次の例は、Clear メソッドを使って、Err オブジェクトの数値型のプロパティは 0 で、文字列型のプロパティは長さ 0 の文字列でリセットします。
このプログラムで Clear メソッドを使用しない場合、一度エラーが発生すると、その後の計算でエラーが発生するかどうかに関係なく、ループのたびにエラーメッセージダイアログボックスが表示されます。

Option Explicit

Private Sub test1()
' 要素がすぐにオーバーフローするような配列を宣言します。
Dim Result(4) As Integer
Dim indx
On Error Resume Next ' エラーのトラップを留保します。
Do Until indx = 4
' 場合によってエラーを発生させ、エラーがない場合は結果を格納します。
Result(indx) = Rnd * indx * 20000
If Err.Number <> 0 Then
MsgBox Err, , "発生したｴﾗｰ: ", Err.HelpFile, Err.HelpContext
Debug.Print indx & ":" & Err.HelpFile & " - " & Err.HelpContext
Err.Clear ' Err オブジェクトのプロパティをクリアします。
Else
indx = indx + 1
End If
Loop
'3:C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA6\1041\VbLR6.chm - 1000006
End Sub

Raise メソッド
実行時エラーを生成します。
構文
object.Raise number, source, description, helpfile, helpcontext
Raise メソッドの構文は、次の対象となるオブジェクトと名前付き引数から構成されています。
指定項目内容
object
必ず指定します。Err オブジェクトへの参照を表すオブジェクト式を指定します。
number
必ず指定します。指定するオブジェクトの Number プロパティに対応し、エラーに割り当てられているエラー番号を示す長整数型 (Long) の整数を指定します。Visual Basic のエラー (Visual Basic の組み込みのエラーとユーザー定義エラー) は、0 ～ 65535 の範囲の値です。0 ～ 512 の値はシステムエラー用に予約されているため、ユーザー定義のエラーに使用できるのは、513 ～ 65535 の範囲の値です。クラスモジュール内で独自のエラー番号を設定するときには、エラー番号を定数 vbObjectError に追加します。たとえば、エラー番号 1050 を発生させるには、名前付き引数 Number に vbObjectError + 513 を割り当てます。
source
省略可能です。エラーを発生させたオブジェクトまたはアプリケーションを指定する文字列式です。オブジェクトにこのプロパティを設定するときには、project.class の形式で設定します。引数 source を指定しないと、現在の Visual Basic プロジェクトのプログラム ID が使われます。
description
省略可能です。エラーメッセージを表す文字列式を指定します。省略した場合、名前付き引数 Number の値が調べられます。Visual Basic の実行時エラーの番号の中に、名前付き引数 Number の値に対応するものがあれば、Error 関数の戻り値が名前付き引数 Description として使われます。名前付き引数 Number に対応する Visual Basic のエラーがない場合は、メッセージ "アプリケーション定義またはオブジェクト定義のエラーです。" が使用されます。
helpfile
省略可能です。このエラーに関するヘルプトピックが含まれる Microsoft Windows のヘルプファイルの絶対パスを指定します。絶対パスを指定していない場合は、Visual Basic ヘルプファイルのドライブ、パス、およびファイル名が使用されます。
helpcontext
省略可能です。名前付き引数 helpfile 内の指定したエラーに関するトピックのコンテキスト番号を指定します。このコンテキスト番号を省略すると、Number プロパティに対応する Visual Basic ヘルプファイルのエラーコンテキスト番号が存在するときには、その番号が使われます。
解説
number を除き、すべての名前付き引数は省略可能です。
ただし、いくつかの引数を指定せずに Raise メソッドを実行したときに、Err オブジェクトの各プロパティの設定値がクリアされていないと、その値がエラーを表す値として使用されます。
Raise メソッドは、Error ステートメントの代わりに、実行時エラーを生成するために使用できます。
Err オブジェクトを使うと、Error ステートメントを使ってエラーを生成するときよりも豊富な情報を取得できるので、クラスモジュールを作成するときにエラーを生成するには Raise メソッドが便利です。
たとえば、Raise メソッドを使用すると、エラーを発生元が Source プロパティに設定され、エラーに対するオンラインヘルプなどを参照できます。
Err オブジェクトの使用例
次の例は、Err オブジェクトのプロパティを使って、エラーメッセージダイアログボックスのメッセージの内容を作成します。
Raise メソッドで Visual Basic のエラーを発生させる場合、エラーを発生させる前に Clear メソッドを使うと、Err オブジェクトのプロパティの値は既定値に戻ります。

Option Explicit

Private Sub test1()
Dim Msg
' エラーが発生したら、エラーメッセージを作成します。
On Error Resume Next ' エラーのトラップを留保します。
Err.Clear
Err.Raise 6 ' "オーバーフロー" エラーを発生させます。
' エラーの発生をチェックした後、メッセージを表示します。
If Err.Number <> 0 Then
Msg = "ｴﾗｰ番号 " & str(Err.Number) & Err.Source & _
" でｴﾗｰが発生しました。" & Chr(13) & Err.Description
Debug.Print Msg
MsgBox Msg, , "ｴﾗｰ", Err.HelpFile, Err.HelpContext
End If
'ｴﾗｰ番号 6VBAProject でｴﾗｰが発生しました。
'オーバーフローしました｡

End Sub

エラー API関数DLLの実行時エラーを回避する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'GetActiveWindow 関数(Windows API)
Declare Function GetActiveWindow Lib "user32" () As Long
'GetWindowRect 関数(Windows API)
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
               lpRect As RECT) As Long

'ウィンドウを構成している四角形の各辺の長さを
'RECT データ構造体に設定します。
'無効なハンドルを渡すとエラーが発生します。

Type RECT
      Left As Long
      Top  As Long
      Right  As Long
      Bottom As Long
End Type

Const ERROR_INVALID_WINDOW_HANDLE   As Long = 1400
Const ERROR_INVALID_WINDOW_HANDLE_DESCR As String _
= "無効なウィンドウハンドルです。"

Sub PrintWindowCoordinates(hwnd As Long)
' ウィンドウの左、右、上、下の位置を
' ピクセル単位で出力します。
Dim rectWindow As RECT
' ウィンドウハンドルと空のデータ構造体を渡します。
' 関数が 0 を返す場合は、エラーが発生しています。
    If GetWindowRect(hwnd, rectWindow) = 0 Then
        ' 無効なハンドルを渡したことにより、エラーが発生した場合は
        ' LastDLLError を調べ、ダイアログボックスを表示します。
        Debug.Print "1." & Err.LastDllError
            If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then
                MsgBox ERROR_INVALID_WINDOW_HANDLE_DESCR, _
                   Title:="エラー !"
                Debug.Print "2." & ERROR_INVALID_WINDOW_HANDLE_DESCR
            End If
    Else
        Debug.Print "Top:" & rectWindow.Top
        Debug.Print "Right:" & rectWindow.Right
        Debug.Print "Bottom:" & rectWindow.Bottom
        Debug.Print "Left:" & rectWindow.Left
    End If
End Sub

Private Sub APIGetError()
Dim GAW As Long
'正常処理
'アクティブウィンドウの座標を取得する
'GetActiveWindow 関数(Windows API)
GAW = GetActiveWindow
Debug.Print "アクティブウィンドウ座標:" & GAW
Call PrintWindowCoordinates(GAW)
'アクティブウィンドウ座標:13175122
'Top:-4
'Right:1028
'Bottom:742
'Left:-4
Call PrintWindowCoordinates(GAW + 1)
'1.1400
'2.無効なウィンドウハンドルです。
End Sub

LastDLLError プロパティ
最後にダイナミックリンクライブラリ (DLL) を呼び出したときのエラーコードを返します。
値の取得のみ可能です。
Macintosh では、LastDLLError は常に 0 の値を返します。
解説
LastDLLError プロパティは、Visual Basic のコードから DLL 呼び出しを行った場合のみ参照できます。
通常、DLL 呼び出しが行われると、呼び出された関数は、関数の実行が正常に終了したかどうかを戻り値として返し、LastDLLError プロパティも設定されます。
どのような値を返すかは、それぞれの DLL についてのドキュメントを参照してください。
失敗を示す値が返された場合、LastDLLError プロパティを確認する必要があります。
LastDLLError プロパティが設定された場合、例外は発生しません。

エラー情報の取得

DLL 関数で発生する実行時エラーは、VBA 内で発生する実行時エラーとは異なり、エラーメッセージボックスが表示されません。
実行時エラーが発生したとき、DLL 関数はエラーが発生したことを示す何らかの値を返しますが、エラーの発生により VBA の実行が中断されることはありません。
Windows API の一部の関数は、実行時エラーのエラー情報を格納します。C/C++ でプログラミングしている場合は、GetLastError 関数を使用して、最後に発生したエラーに関する情報を取得できます。
ただし、VBA から GetLastError を呼び出した場合、正確な結果が返されないことがあります。
VBA から DLL エラーに関する情報を取得する場合、VBA Err オブジェクトの LastDLLError プロパティを使用できます。
LastDLLError プロパティは発生したエラーの番号を返します。
LastDLLError プロパティを使用するには、どのエラー番号がどのエラーに対応しているかを知っておく必要があります。
この情報を Win32API.txt ファイルから得ることはできませんが、Microsoft Platform SDK から無償で入手できます。
Platform SDK
http://msdn2.microsoft.com/en-us/library/aa383750.aspx

エラー Error関数で擬似エラーをさせエラーを番号一覧を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Error 関数

指定したエラー番号に対応するエラーメッセージを返します。

構文
Error[(errornumber)]
引数 errornumber には任意のエラー番号を指定します。この引数は省略可能です。有効な範囲内で定義されていない番号を引数 errornumber に指定すると、Error 関数は "ユーザー定義エラー" という文字列を返します。引数 errornumber が有効な範囲内の番号であり、定義されていない場合、Error 関数は文字列 "アプリケーション定義またはオブジェクト定義のエラーです。" を返します。有効な範囲外の番号を指定すると、実行時エラーが発生します。引数 errornumber を省略すると、最後に発生した実行時エラーに対応するメッセージを返します。実行時エラーが発生していない場合、Error 関数は長さ 0 の文字列 ("") を返します。
解説
Err オブジェクトのプロパティの設定値を検証して、最新の実行時エラーを識別します。Error 関数の戻り値は、Err オブジェクトの Description プロパティに対応します。
Error 関数の使用例
次の例は、Error 関数を使って、エラー番号に対応したエラーメッセージを出力します。

Option Explicit

Sub ErrList()
'************************************************
'Err関数で擬似エラーをさせエラーを番号一覧を取得
'************************************************

Dim i As Long
Dim str As String
Dim strTrp As String

strTrp = "アプリケーション定義またはオブジェクト定義のエラーです。"

    For i = 1 To 1000
        str = Error(i)
        If str <> strTrp Then
            Debug.Print i & vbTab & str
        End If
    Next i

End Sub

'3   Return に対応する GoSub がありません。
'5   プロシージャの呼び出し､または引数が不正です｡
'6   オーバーフローしました｡
'7   メモリが不足しています｡
'9   インデックスが有効範囲にありません｡
'10  この配列は固定されているか､または一時的にロックされています｡
'11  0 で除算しました。
'13  型が一致しません｡
'14  文字列領域が不足しています｡
'16  式が複雑すぎます｡
'17  要求された操作は実行できません｡
'18  ユーザーによる割り込みが発生しました｡
'20  エラーが発生していないときに Resume を実行することはできません。
'28  スタック領域が不足しています｡
'35  Sub または Function が定義されていません。
'47  DLL のクライアントアプリケーションの数が多すぎます。
'48  DLL 読み込み時のエラーです｡
'49  DLL が正しく呼び出せません｡
'51  内部エラーです｡
'52  ファイル名または番号が不正です｡
'53  ファイルが見つかりません｡
'54  ファイルモードが不正です｡
'55  ファイルは既に開かれています｡
'57  デバイス I/O エラーです。
'58  既に同名のファイルが存在しています｡
'59  レコード長が一致しません｡
'61  ディスクの空き容量が不足しています｡
'62  ファイルにこれ以上データがありません｡
'63  レコード番号が不正です｡
'67  ファイルが多すぎます｡
'68  デバイスが準備されていません｡
'70  書き込みできません｡
'71  ディスクが準備されていません｡
'74  ディスク名は変更できません｡
'75  パス名が無効です｡
'76  パスが見つかりません｡
'91  オブジェクト変数または With ブロック変数が設定されていません。
'92  For ループが初期化されていません。
'93  パターン文字列が不正です｡
'94  Null の使い方が不正です。
'96  サポートされているイベント受信最大数のイベントが既に発生してい
'    るので､オブジェクトのイベントシンクを実行できません｡
'97  オブジェクトが定義クラスのインスタンスではない場合､このオブジェ
'    クトに関するフレンド関数は呼び出せません｡
'98  プロパティまたはメソッドの呼び出しの場合には､引数または戻り値と
'    してプライベートオブジェクトへの参照を含めることはできません｡
'321 不正なファイル形式です｡
'322 必要な一時ファイルを作成できません｡
'325 リソースファイルの形式が不正です｡
'380 プロパティの値が不正です｡
'381 不正なプロパティ配列インデックスです｡
'382 実行時には値を設定できません｡
'383 値を設定できません｡値の取得のみ可能なプロパティです｡
'385 プロパティ配列インデックスが必要です｡
'387 値を設定できません｡
'393 実行時には値を取得できません｡
'394 値を取得できません｡値の設定のみ可能なプロパティです｡
'422 プロパティが見つかりません｡
'423 プロパティまたはメソッドが見つかりません｡
'424 オブジェクトが必要です｡
'429 ActiveX コンポーネントはオブジェクトを作成できません｡
'430 クラスはオートメーションまたは予測したインターフェースをサポート
'    していません｡
'432 オートメーションの操作中にファイル名またはクラス名を見つけられま
'    せんでした｡
'438 オブジェクトは､このプロパティまたはメソッドをサポートしていません｡
'440 オートメーションエラーです｡
'442 リモートプロセス用のタイプライブラリまたはオブジェクトライブラリ
'    への参照は失われました。参照設定を解除して [OK] を押してください。
'443 オートメーションオブジェクトには既定値がありません｡
'445 オブジェクトはこの動作をサポートしていません｡
'446 オブジェクトは名前付き引数をサポートしていません｡
'447 オブジェクトは現在の国別情報の設定をサポートしていません｡
'448 名前付き引数が見つかりません｡
'449 引数は省略できません｡
'450 引数の数が一致していません｡または不正なプロパティを指定しています｡
'451 Property Let プロシージャが定義されておらず、Property Get プロシージ
'    ャからオブジェクトが返されませんでした。
'452 序数が不正です｡
'453 関数は指定された DLL には定義されていません。
'454 コードリソースが見つかりません｡
'455 コードリソースのロックエラーです。
'457 このキーは既にこのコレクションの要素に割り当てられています｡
'458 Visual Basic でサポートされていないオートメーションが変数で使用されて
'    います。
'459 オブジェクトまたはクラスがこのイベントセットをサポートしていません｡
'460 クリップボードのデータ形式が不正です｡
'461 メソッドまたはデータメンバが見つかりません｡
'462 リモートサーバーがないか､使用できる状態ではありません｡
'463 ローカルマシンにクラスが登録されていません｡
'481 ピクチャが不正です｡
'482 プリンタエラーです｡
'735 一時ファイルに保存できません｡
'744 検索文字列が見つかりませんでした｡
'746 置換後の文字列が長すぎます｡

WEB Win標準装備FTPexeを使いVBAで操作-7

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

バッチファイルをタスクに登録し自動実行する

１タスクスケジューラを起動する

スタート
管理ツール
タスクスケジューラ

２

基本タスクの作成

３

名前を入力する。

４

トリガー（引き金）開始区分を選択

５

日付や時刻を設定

６

操作の種別を選択。

７

該当batを選択。

８

完了ボタン。

９

タスクの追加を確認する。

同一時刻に実行されるよう設定された 2 つのタスクが存在すると問題が発生することがあります。
最初のタスクが正しく発行されると、[タスクを実行中] と表示されます。
このとき次のタスクが実行されないと、最初のタスクの後処理が完了しないままとなります。
タスクの状態が [タスクを実行中] と表示されているため、以後 Mstask.exe がタスクを実行しようとし続けても実行されません。

WEB Win標準装備FTPexeを使いVBAで操作-6

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

[バッチファイル](.bat又は.cmd)。
[コマンドファイル](.txt)スクリプトファイルの作成とバッチの実行。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

１

アップするファイルを用意。
例ではhtmファイルを３つ用意。

２

バッチファイル名は任意でＯＫ
テキストファイルで作成後拡張子を.batに変更。
例ではtest.batとした。
同じ階層にコマンドファイルを作成。
例ではftptest.txtとしたが任意ファイル名でもＯＫ。

３

バッチファイルは右クリックの編集で簡単に編集可能。

４

バッチファイル(シェルスクリプト)
test.batの内容
echo off
ftp -vni -s:ftptest.txt
echo offはメッセージを非表示する
①ftp ②-vni
①ftp.exeを起動
②コマンド組み合わせ（下表）
③-s:④ftptest.txt
③コマンドファイル指定（下表）
④ftptest.txtを指定

ftp-Windowsコマンド詳細
コマンド	動作	記述例
-a	データ接続バインドのローカル・インターフェース使用	-a
-A	匿名ログオン	-A
-D	コマンド表示(デバッグ)	-D
-G	ファイル名[globbing]無効	-G
HOST	サーバーコンピュータ名及びIPアドレスを指定	HOST
-I	対話型プロンプト非表示	-I
-N	自動ログオン機能無効（初回接続）	-N
-S	コマンドファイル指定	-S:XXX.txt
-V	サーバー応答非表示	-V
-W	転送バッファサイズ指定（デフォルト4096byte）	-W:3000

５

コマンドファイル ftptest.txtの内容
①open jp-ia.com
②user ***** *******
③hash
④ascii
⑤cd www/test/
⑥lcd C:\Temp
⑦mput *.htm
⑧quit
①サーバオープン
②アカウント及びパスワード
③MS-DOSに#で実行状況を表示（プログレスバー）
④アスキーモード指定
⑤サーバ上のディレクトリ移動（サーバの殆どが多言語非対応・UNIX系なので大文字小文字区別で英数のみで指定）
⑥ローカル（ＵＰするフォルダ）移動。こちらはローカル上なので日本語や空白は認識※1する。
⑦複数ファイルをアスタリスクで指定（複数指定方法は「a*」等自由だが拡張子を無視した場合は画像ファイル等のバイナリモードでの実行が必要なものもあるので注意が必要）
⑧終了
コマンド詳細は前ページ

*.jpg *.gif *.png など画像ファイルの場合は ④でバイナリモード指定又、フォルダ（ディレクトリ）単位でのUPは出来ないのでサーバ側に該当フォルダが無い場合は先ず作成してからUPすること（すべてコマンドファイルで可能です）。
どうしてもエラーになる場合は⑧のquitを消してみる。
それでも判明しない場合は上記プラス+バッチファイルの-vniの箇所を-nに変更して実行。
意味が判らない場合は最初から読んで下さい。
※1コマンドファイル上では認識しますがバッチファイル(シェルスクリプト)では認識しません。

６

アップロード先のディレクトリー（現在は空）。

７

バッチファイルの実行。
右クリック・開く又はダブルクリック。
途中で停止したい場合キーボード[Ctrl] + [C] 。

８

実行後のアップロード先ディレクトリー。

９

バッチファイルがコマンドファイルの内容を読み取り実行したMS-DOSの内容。

この方法は理解する上でのテスト的なものです。
この方法では以下の問題に直面致します。

①UPするディレクトリが複数又は大量にある場合すべてのディレクトリを指定した場合、無駄がある。
②コマンドファイルにパスワードを記述するためセキュリティ不全仮にコマンドファイルが複数存在する場合、その個々のコマンドファイルにアカウントとパスワードがセットで記述されており何処に何個あるか？等、管理が大変。
③FTPexeはアップロード又はダウンロード中エラーが起きた場合（コネクション切断）でも再実行しないその為、完全にアップロード又はダウンロード出来たかは実際に確認しないとならない。

そこで①～③までの問題を８～９割、解決するのが最終章です。
プログラマーの方は別としてここまでが把握出来ないと最終章では難しくなるのできちんと把握が必要です。
最終章に行く前にタスク登録方法もご覧下さい。

WEB Win標準装備FTPexeを使いVBAで操作-8

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

「WEB Win標準装備FTPexeを使いVBAで操作-6」のバッチファイルとコマンドファイルを把握してからご覧下さい。
VB又はVBAで記述する。

１

バッチファイルからコマンドファイルを生成する。
今度はWEB Win標準装備FTPexeを使いVBAで操作-6で作成したコマンドファイルをバッチファイルで作成します。
以下の例は「ftptest.bat」とファイル名を指定。

:: ===============================================
:: バッチファイルの基礎
:: ===============================================
:: ←[::]は[rem]つまりコメント

:: ***********************************************
:: 各環境変数定義（set）
:: ***********************************************
:: ■コマンドファイル生成場所の変数定義
set cmdPath=C:\Temp
:: ■コマンドファイル名の変数定義
set cmdFire=%cmdPath%\ftptest.txt
:: -----------------------------------------------
:: ■サーバ名の変数定義
set cmdopen=open jp-ia.com
:: ■ユーザ名とパスワードの変数定義
set cmdpw=user ユーザ名パスワード
:: ■hashの変数定義
set cmdhash = hash
:: ■モードの変数定義
set cmdascii = ascii
:: ■アップ先の変数定義
set cmdcd=cd www/test/
:: ■アップ元の変数定義(日本語OK)
set cmdlcd=lcd C:\Temp\アップ
:: ■アップするファイルの変数定義
set cmdput = mput * .htm
:: ■終了コマンドの変数定義
set cmdquit = Quit

:: ***********************************************
:: コマンドファイルに必要事項を入力記入 (echo)
:: ***********************************************
:: ※「>,>>」はリダイレクト
:: ※「>」は新規又は上書き
:: ※「>>」は追加
:: ※「%」環境変数を使う場合はその変数を「%」で囲みます

echo %cmdopen%>%cmdFire%
echo %cmdpw%>>%cmdFire%
echo %cmdhash%>>%cmdFire%
echo %cmdascii%>>%cmdFire%
echo %cmdcd%>>%cmdFire%
echo %cmdlcd%>>%cmdFire%
echo %cmdput%>>%cmdFire%
echo %cmdquit%>>%cmdFire%

:: 終わり

２

ftptest.txtの中身。
上記を実行後、作成されたテキストファイル。

C:\TempつまりCドライブ直下に[Temp]というフォルダを作成して下さい。(無い場合) 上記をテキストファイルにコピーし任意の場所へ保存後 [XXXX.bat]のような任意の名前に変更、実行してみて下さい
どうですか？
WEB Win標準装備FTPexeを使いVBAで操作-6で作成したコマンドファイルと粗同じものが C:\Tempに生成されています。
[XXXX.bat]で使えるコマンドはコマンドファイルの実行の他にもコマンドファイルの削除等もっと沢山あります。
以下の例は「ftptest1.bat」とファイル名を指定

:: ===============================================
:: バッチファイルを実行､実行ログ作成
:: ===============================================
:: ←[::]は[rem]つまりコメント

:: ***********************************************
:: 各環境変数定義（set）
:: ***********************************************

:: ■実行テキストファイルの変数定義
set cmdTxtPath=C:\Temp\ftptest.txt
:: ■ログファイル生成場所の変数定義
set cmdLogPath=C:\Temp\ftplog
:: ■日付を取得及び変数定義
set cmdDateA=%date%
:: 必要箇所文字を取り出し結合
set cmdDateB=%cmdDateA:~0,4%%cmdDateA:~-5,2%%cmdDateA:~-2,2%
:: ■時刻を取得及び変数定義
:: 空白を0に置き換え格納
set cmdTimeA=%time: =0%
:: 必要箇所文字を取り出し結合
set cmdTimeB=%cmdTimeA:~0,2%%cmdTimeA:~3,2%%cmdTimeA:~6,2%
:: ◇ログを保存するフォルダ作成
MkDir "%cmdLogPath%\"

:: ***********************************************
:: FTP実行
:: ***********************************************
:: ◇テキストファイル実行及びログファイルの生成
ftp -vni -s:%cmdTxtPath%>%cmdLogPath%\%cmdDateB%_%cmdTimeB%.txt
:: ◇実行テキストファイルの削除
del %cmdTxtPath%

３

上記は先ほど作成したテキストファイル（コマンドファイル）を実行し更に実行結果のログファイルを生成し更にテキストファイル（コマンドファイル）を削除します
実行順は先ずftptest.batそれからftptest1.batになります。
ftptest1.batはファイルをアップする実行を行いますのでアップするファイル数により相応の時間を要します。
実行状況は非表示ですがログにはきちんと記録されます。

C:\Windows\Tempから実行ログファイルを探す。
上記がログファイル
ハッシュは[###]で表示されます。
他にも「mput *.htm」の後に仮のファイルをアップして今度はそのファイルを「get」コマンドでダウンロードという方法もありますがログを残すのがベターでしょう。
VBやVBAで作成する場合もコマンドファイルテキストを作成し、それを実行する上記のようなftptest1.batを作成し ftptest1.batはタスクに登録PC電源を落とさず寝る
寝ているうちに実行。
朝、確認。
その他サイトマップを生成しておき同じ要領でアップするなどいろいろアレンジして実行してみて下さい。
同一時刻に実行されるよう設定された 2 つのタスクが存在すると問題が発生することがあります。最初のタスクが正しく発行されると、[タスクを実行中] と表示されます。
このとき次のタスクが実行されないと、最初のタスクの後処理が完了しないままとなります。
タスクの状態が [タスクを実行中] と表示されているため、以後 Mstask.exe がタスクを実行しようとし続けても実行されません。

同一時刻に実行されるよう設定された 2 つのタスクが存在すると問題が発生することがあります。最初のタスクが正しく発行されると、[タスクを実行中] と表示されます。
このとき次のタスクが実行されないと、最初のタスクの後処理が完了しないままとなります。
タスクの状態が [タスクを実行中] と表示されているため、以後 Mstask.exe がタスクを実行しようとし続けても実行されません。

４

VB/VBAから直接コマンドファイルテキストを実行しログファイルも作成する

Option Explicit

Sub ShellFTPlog()
'*****************************************
'ShellでFTP.exeコマンドを実行しログを残す
'*****************************************

'通常このように記述しますが
'Shell(ftp -vni -s:"C:\Temp\ftptest.txt">"C:\Temp\ftplog\testLog.txt",6)
'ログを残すコマンド、[>]リダイレクトが付加する為
'①コマンドインタープリタ(16ビット)
'②パイプ[|]
'①～②の関係でエラーになります
'この場合は「コマンドプロンプト経由」で記述します

Dim txtPath As String
Dim cmd(4) As String
Dim LogPath As String

Dim RetVal As Variant

cmd(1) = "cmd.exe /c "
cmd(2) = "ftp -vni -s:"
cmd(3) = ">"
txtPath = """C:\Temp\ftptest.txt"""
LogPath = """C:\Temp\ftplog\testLog.txt"""
cmd(4) = cmd(1) & cmd(2) & txtPath & cmd(3) & LogPath

'cmd(4) =[cmd.exe /c ftp -vni -s:"C:\Temp\ftptest.txt">"C:\Temp\ftplog\testLog.txt"]

RetVal = Shell(cmd(4), 6)

If RetVal <> 0 Then
MsgBox txtPath & vbCr & "実行されました。", vbInformation, "[タスクID]" & RetVal
Else
MsgBox txtPath & vbCr & "実行出来ません。", vbCritical, "[ERROR]"
End If

End Sub

WEB WWWアドレスをローカルアドレスに変更・WWWアドレスをFTP用アドレスに変更

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function ServerAddressLocal(wwwAddress As String) As String
'***************************************
'WWWアドレスをローカルアドレスに変更
'***************************************
'サーバー上のディレクトリーとローカルフォルダを一致させる
Dim strDel As String, str As String, BasicPointAddress As String

'正規アドレスから削除するアドレス
strDel = "http://www.xxxxx.com/"
'ローカル上の対象フォルダパス
BasicPointAddress = "C:\xxxx\yyyyy\zzzz\www"

    str = wwwAddress
    str = Trim(Mid(str, Len(strDel) + 1))
    str = Trim(Mid(str, 1, Len(str) - 1))

ServerAddressLocal = BasicPointAddress & "\" & str
End Function

Function FTPUpAddress(wwwAddress As String) As String
'***************************************
'WWWアドレスをFTP用アドレスに変更
'***************************************
'サーバーUP用のFTPアドレスに変更
Dim strDel As String, str As String, BasicPointAddress As String

'正規アドレスから削除するアドレス
strDel = "http://www.xxxxx.com/"

    str = wwwAddress
    str = Trim(Mid(str, Len(strDel) + 1))
    str = Trim(Mid(str, 1, Len(str) - 1))

FTPUpAddress = "www/" & str & "/"
End Function

エラー ErrオブジェクトNumberプロパティ解説と使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Number プロパティ

エラーを指定する数値を設定します。
値の取得も可能です。
Number プロパティは、Err オブジェクトの既定プロパティです。
値の取得のみ可能です。
解説
オブジェクトからユーザー定義エラーを取得する場合は、エラーとして選択した数値を定数 vbObjectError に追加して Err オブジェクトの Number プロパティに設定します。
たとえば、次のコードを使って、番号 1051 をエラーコードとして取得します。

Option Explicit

Err.Raise Number:=vbObjectError + 1051, Source:="SomeClass"

Number プロパティの使用例
最初の例では、エラー処理ルーチンでの Number プロパティの典型的な使用方法を示しています。

Option Explicit

Private Sub test1()
'Number プロパティの典型的な使用例。

On Error GoTo out

Dim x, y
x = 1 / y ' 0 で除算するエラーを生成します。
Exit Sub

out:
MsgBox Err.Number
Debug.Print Err.Number
MsgBox Err.Description
Debug.Print Err.Description

' 0 で除算したエラーかどうかを調べます。
If Err.Number = 11 Then
y = y + 1
End If

Resume
'11
'0 で除算しました｡
End Sub

例では、Err オブジェクトの Number プロパティの値を見て、オートメーションオブジェクトによって返されたエラーが、オブジェクトによって定義されたものであるか、または Visual Basic によって定義されたエラーに割り当てられたものであるかを調べます。
定数 vbObjectError は大きな負の値で、サーバーによって定義されたエラーであることを示すために、オブジェクトが自分のエラー番号に加算するものです。
したがって、Err.Number から定数 vbObjectError を差し引けば、オブジェクト定義のエラーか、Visual Basic 定義のエラーかが判別できます。
エラーがオブジェクト定義のエラーである場合は、元のエラー番号は Error.Number に格納されています。
この番号は、エラーの発生元と共にメッセージボックスに表示されます。
エラーが Visual Basic のエラーである場合は、そのエラー番号をメッセージボックスに表示します。

Option Explicit

Private Sub test2()
'オートメーションオブジェクトによって返されたエラーが設定された
'Number プロパティを使用します。
Dim MyError, Msg
'最初に、オブジェクト自身のエラーであることを示すために
'加算した定数を引きます。
MyError = Err.Number - vbObjectError
' 定数 vbObjectError を差し引いた結果のエラー番号が、
'0 ～ 65,535 の範囲内にある場合、そのエラー番号は
'オブジェクト定義のエラー番号です。
If MyError > 0 And MyError < 65535 Then
Msg = "アクセスしたオブジェクトが、エラーに対して番号 " & MyError & _
" を割り当てました。エラーの発生元は " & Err.Source & _
" です。エラー発生元のヘルプを参照するには、F1 キーを押してください。"
' 0 ～ 65,535 の範囲外である場合は、Visual Basic のエラー番号です。
Else
Msg = "このエラー (エラー番号 " & Err.Number & ") は、" & _
"Visual Basic のエラー番号です。" & _
" このエラーに関する Visual Basic のヘルプを参照するには、" _
& " ヘルプボタンまたは F1 キーを押してください。"
End If
MsgBox Msg, , "ｵﾌﾞｼﾞｪｸﾄｴﾗｰ ", Err.HelpFile, Err.HelpContext

End Sub

エラー Errオブジェクト

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Err オブジェクト
- 解説
プロパティ
メソッド
- Clear メソッド
  - 解説
  - Clear メソッドの使用例
- Raise メソッド
  - 解説
  - Err オブジェクトの使用例

Err オブジェクト

Err オブジェクトは、実行時エラーに関する情報を保有しています。

解説
Err オブジェクトのプロパティは、エラーを発生させた Visual Basic、オブジェクト、または Visual Basic のプログラマによって設定されます。
Err オブジェクトの既定プロパティは Number プロパティです。既定プロパティは Err オブジェクトを指定することにより参照できます。以前のバージョンで Err 関数または Err ステートメントを使用して記述したコードを変更する必要はありません。
実行時エラーが発生すると、そのエラーを識別するための情報など、エラー処理で利用可能な情報が、Err オブジェクトに格納されます。コード内で実行時エラーを生成するときには、Raise メソッドを使います。
Err オブジェクトの各プロパティは、エラー処理ルーチン内の Exit Sub、Exit Function、Exit Property、Resume Next ステートメントの後で、0 または長さ 0 の文字列 ("") にリセットされます。
エラー処理ルーチンの外側で Resume ステートメントを使用した場合は、Err オブジェクトのプロパティはリセットされません。
Clear メソッドを使うと、Err を明示的にリセットすることができます。
システムエラーやクラスモジュールに対して実行時エラーを生成する場合は、Error ステートメントではなく、Raise メソッドを使用します。そのほかのモジュールのコードで Raise メソッドを使用するかどうかは、返される情報の量によって決定します。
Err オブジェクトは、適用範囲 (スコープ) がパブリックである組み込みオブジェクトです。コード内でそのインスタンスを作成する必要はありません。

プロパティ

Description プロパティ
オブジェクトに関連付けられている説明の文字列を含む文字列式を設定します。値の取得も可能です。
解説
Err オブジェクトでは、エラーに関連する説明の文字列を設定します。値の取得も可能です。
Description プロパティの使用例
次の例は、Err オブジェクトの Description プロパティにユーザー定義のメッセージを設定します。

Option Explicit

Private Sub test()
Dim Msg
Err.Clear
On Error Resume Next
Err.Raise 6 ' "オーバーフローしました。" エラーを発生させます。
    If Err.Number <> 0 Then
    Err.Description = "この操作に必要なオブジェクトに" _
    & "アクセスすることができませんでした。"
        Msg = "ヘルプコンテキスト番号 " _
        & Err.HelpContext & " について " & _
        Err.HelpFile _
        & " のヘルプを参照するには、F1 キーまたは Help キーを押してください。"

        MsgBox Msg, , "ｴﾗｰ : " & _
        Err.Description, Err.HelpFile, Err.HelpContext
        Debug.Print Err.Description
        Debug.Print Err.HelpFile
        Debug.Print Err.HelpContext
    End If
'この操作に必要なオブジェクトにアクセスすることができませんでした｡
'C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA6\1041\VbLR6.chm
'1000006
End Sub

HelpContext プロパティ
ヘルプファイルのトピックに対応するコンテキスト番号を含む文字列式を設定します。値の取得も可能です。
解説
HelpContext プロパティを指定すると、HelpFile プロパティで指定したヘルプトピックが自動的に表示されます。HelpFile プロパティと HelpContext プロパティが空の場合は、Number プロパティの値がチェックされます。その値が Visual Basic の実行時エラーの値に対応している場合は、そのエラーを表す Visual Basic ヘルプのコンテキスト番号が使われます。Number プロパティの値が Visual Basic エラーに対応していない場合は、Visual Basic ヘルプファイルの目次画面が表示されます。
HelpContext プロパティの使用例
次の例は、Err オブジェクトの HelpContext プロパティを使って、"オーバーフローしました。" エラーに対応する Visual Basic のヘルプを表示します。

Option Explicit

Private Sub test()
Dim Msg
Err.Clear
On Error Resume Next
Err.Raise 6 ' "オーバーフローしました。" エラーを発生させます。
    If Err.Number <> 0 Then
        Msg = "ヘルプコンテキスト番号 " _
        & Err.HelpContext & " について " & _
        Err.HelpFile _
        & " のヘルプを参照するには、F1 キーまたは Help キーを押してください。"

        MsgBox Msg, , "ｴﾗｰ : " & _
        Err.Description, Err.HelpFile, Err.HelpContext
        Debug.Print Err.Description
        Debug.Print Err.HelpFile
        Debug.Print Err.HelpContext
    End If
'オーバーフローしました｡
'C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA6\1041\VbLR6.chm
'1000006
End Sub

HelpFile プロパティ
ヘルプファイルへの絶対バスを含む文字列式を設定します。値の取得も可能です。
解説
エラー ErrオブジェクトHelpFileプロパティ解説と使用例　を参照そて下さい。
HelpFile プロパティの使用例
エラー ErrオブジェクトHelpFileプロパティ解説と使用例　を参照そて下さい。
LastDLLError プロパティ
解説
エラー API関数の実行時エラーを回避する　を参照そて下さい。
LastDLLError プロパティの使用例
エラー API関数の実行時エラーを回避する　を参照そて下さい。
Number プロパティ
解説
エラー ErrオブジェクトNumberプロパティ解説と使用例　を参照そて下さい。
Number プロパティの使用例
エラー ErrオブジェクトNumberプロパティ解説と使用例　を参照そて下さい。
Source プロパティ
エラーの発生元のオブジェクトまたはアプリケーションの名前を示す文字列式を設定します。値の取得も可能です。
解説
Source プロパティは、エラーを発生させたオブジェクトを表す文字列式を指定します。
一般に、この式はそのオブジェクトのクラス名またはプログラム ID です。
アクセスされたオブジェクトで発生したエラーを処理できないときには、Source プロパティを使って情報を提供してください。
たとえば、Microsoft Excel にアクセスしたときに "0 で除算しました。
" エラーが発生すると、エラーを発生させたオブジェクト Excel によって Err オブジェクトの Number プロパティにそのエラーを表すエラー番号が設定され、Source プロパティに Excel.Application が設定されます。
コードを使用してエラーを生成する場合、Source プロパティにはアプリケーションのプログラム ID が設定されます。
クラスモジュールの場合は、Source プロパティに project.class の形式でクラスの名前を格納する必要があります。
作成したコードで予期しないエラーが発生すると、自動的に Source プロパティが設定されます。標準モジュール内のエラーの場合、Source プロパティにはプロジェクトの名前が格納されます。
クラスモジュール内のエラーの場合、Source プロパティには project.class の形式でクラスの名前が格納されます。
Source プロパティの使用例
次の例は、Visual Basic で作成されたオートメーションオブジェクトのプログラム ID を変数 MyObjectID に代入し、その後、Raise メソッドでエラーを発生させるときに、この変数を Err オブジェクトの Source プロパティに代入しています。
エラー処理を行うときには、Source プロパティおよび Err オブジェクトのプロパティのうち Number プロパティ以外のプロパティをコード内で使用しないでください。
Number プロパティ以外のプロパティは、コードで処理できないエラーが発生した場合に、詳細な情報を表示する目的でのみ使用してください。
この例では、App と MyClass への参照が有効であることを想定しています。

Option Explicit

Private Sub test1()
Dim MyClass, MyObjectID, MyHelpFile, MyHelpContext
'MyClass という種類のオブジェクトは、エラーを生成し、
'Source プロパティを含め、Err オブジェクトの全プロパ
'ティを設定します。
'Source プロパティには、App オブジェクトの Title プロ
'パティと MyClassオブジェクトの Name プロパティを組み
'合わせた変数 MyObjectID を代入します。
MyObjectID = App.Title & "." & MyClass.Name
Err.Raise Number:=vbObjectError + 894, Source:=MyObjectID, _
Description:="プログラムを完了することができませんでした。", _
HelpFile:=MyHelpFile, HelpContext:=MyHelpContext

End Sub

メソッド

エラー ErrオブジェクトHelpFileプロパティ解説と使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

HelpFile プロパティ

ヘルプファイルへの絶対バスを含む文字列式を設定します。値の取得も可能です。
解説
ヘルプファイルを HelpFile プロパティで指定すると、エラーメッセージが表示されるダイアログボックス内で [ヘルプ] ボタンをクリックするか、または F1 キー (Windows) か Help キー(Macintosh) )を押したときに自動的に呼び出されます。HelpContext プロパティに指定したファイルの有効なコンテキスト番号が入っていると、そのトピックが自動的に表示されます。HelpFile プロパティを指定しない場合は、Visual Basic のヘルプファイルが表示されます。
HelpFile プロパティの使用例
次の例は、Err オブジェクトの HelpFile プロパティを使って、ヘルプを表示します。特に指定しない限り、HelpFile プロパティには Visual Basic のヘルプファイルの名前が格納されています。

Option Explicit

コントロール ListBoxコントロール、Listプロパティの使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Dim MyArray(6, 3)

Private Sub UserForm_Initialize()

    Dim i As Single

    ListBox1.ColumnCount = 3

    For i = 0 To 5
        MyArray(i, 0) = i
        MyArray(i, 1) = Rnd
        MyArray(i, 2) = Rnd
    Next i

    ListBox1.List() = MyArray

End Sub

Private Sub CommandButton1_Click()
' 1 列目と 3 列目の内容を入れ替えます。

    Dim i As Single
    Dim Temp As Single

    For i = 0 To 5
        Temp = ListBox1.List(i, 0)
        ListBox1.List(i, 0) = ListBox1.List(i, 2)
        ListBox1.List(i, 2) = Temp
    Next i
End Sub

エラー On_Error・Resumeステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

On Error ステートメント
Resume ステートメント
On Error ステートメントResume ステートメントの使用例

On Error ステートメント

エラー処理ルーチンを有効にし、プロシージャ内でのエラー処理ルーチンの位置を指定します。エラー処理ルーチンを無効にするときに使うこともできます。

構文
On Error GoTo line
On Error Resume Next
On Error GoTo 0
On Error ステートメントの形式は次のとおりです。
ステートメント内容
On Error GoTo line
引数 lineに指定した行から始まるエラー処理ルーチンを有効にします。
引数 line は必ず指定します。
引数 line には任意の行ラベルまたは行番号を指定します。
実行時エラーが生成されると、ここで設定したエラー処理ルーチンにプログラムの制御が移り、エラー処理ルーチンがアクティブになります。
引数 line に指定する行は、On Error ステートメントと同じプロシージャ内に存在しなければなりません。
この制限に従わなければ、コンパイル時エラーが発生します。
On Error Resume Next
実行時エラーが発生してもプログラムを中断せず、エラーが発生したステートメントの次のステートメントから実行を継続します。
オブジェクトを操作する場合は、On Error GoTo ステートメントではなく、このステートメントを使ってください。
On Error GoTo 0
現在のプロシージャに含まれる使用可能なエラー処理ルーチンを無効にします。
解説
On Error ステートメントを使用していない場合に実行時エラーが発生すると、そのエラーは致命的エラーになり、エラーメッセージが表示されてプログラムの実行が停止します。
"使用可能な" エラー処理ルーチンとは、On Error ステートメントによって有効になっている処理ルーチンのことです。
"アクティブな" エラー処理ルーチンとは、エラー処理中の使用可能な処理ルーチンのことです。
エラー処理ルーチンがアクティブになっている間 (エラーの発生と Resume、Exit Sub、Exit Function、または Exit Property ステートメントの間) は、カレントプロシージャのエラー処理ルーチンはエラーを処理できません。
制御は呼び出し側のプロシージャに戻ります。
呼び出し側のプロシージャに使用可能なエラー処理ルーチンがあれば、そのルーチンがエラーを処理するためにアクティブになります。
呼び出し側のプロシージャのエラー処理ルーチンもアクティブであれば、使用可能で非アクティブなエラー処理ルーチンが見つかるまで、制御はプロシージャを呼び出したプロシージャへと引き渡されます。
使用可能で非アクティブなエラー処理ルーチンが見つからなければ、そのエラーは実際に発生した位置で致命的なエラーになります。
エラー処理ルーチンがコントロールを呼び出し側のプロシージャに戻すたびに、そのプロシージャがカレントプロシージャになります。
いずれかのプロシージャ内でエラー処理ルーチンによってエラーが処理されると、Resume ステートメントで指定した時点でカレントプロシージャ内で実行が再開されます。
メモ
エラー処理ルーチンは、Sub プロシージャまたは Function プロシージャではありません。行ラベルまたは行番号で識別されるコードの一部分です。
エラー処理ルーチンは、Err オブジェクトの Number プロパティを基にエラーの原因を判別します。
また、エラー処理ルーチンは他のエラーが発生する前、またはエラーを引き起こすプロシージャが呼び出される前に、関連する Err オブジェクトのプロパティの値をテストまたは保存する必要があります。
Err オブジェクトのプロパティの値には、最新のエラーだけが反映されます。Err オブジェクトの Number プロパティに関連付けられたエラーメッセージは、Err オブジェクトの Description プロパティに指定されています。
On Error Resume Next ステートメントは、実行時エラーを発生させたステートメントの直後にあるステートメント、または On Error Resume Next ステートメントを含むプロシージャから最後に呼び出しを行った直後のステートメントを使って、実行を継続します。
このステートメントを使って、実行時エラーが生成されても処理を続けることができます。
プロシージャ内の他の場所に制御を移動せずに、エラー処理ルーチンをエラーが発生する可能性のある場所に配置できます。
On Error Resume Next ステートメントは、別のプロシージャが呼び出されるとアクティブでなくなるので、そのルーチン内でインラインエラー処理を行う場合は、呼び出される各ルーチン内で On Error Resume Next ステートメントを実行する必要があります。
メモ
他のオブジェクトを操作しているときに発生したエラーを処理する場合は、On Error GoTo ステートメントよりも On Error Resume Next 構造の方が適しています。
オブジェクトとの各やり取りの後で Err オブジェクトを調べることにより、どのオブジェクトをコードで操作したのかどうかを確認します。
Err オブジェクトの Number プロパティにエラーコードを設定したオブジェクト、および最初にエラーを発生させたオブジェクトを Err オブジェクトの Source プロパティで調べることができます。
On Error GoTo 0 ステートメントは、現在のプロシージャ内のエラー処理を無効にします。
プロシージャに番号が 0 の行が含まれていても、その行はエラー処理コードの先頭として指定されません。
On Error GoTo 0 ステートメントを指定していない場合、エラー処理ルーチンはプロシージャの終了時に自動的に無効になります。
エラーの発生時以外にエラー処理コードが実行されないようにするには、そのエラー処理ルーチンの直前に Exit Sub、Exit Function、または Exit Property のうち、該当するステートメントを配置します。
次に例を示します。

Option Explicit

Private Sub test1()
Dim a As Double
    Debug.Print "A"
On Error GoTo Jump
    a = 2 / 0 '───┐
    Debug.Print "B" '┼┐
    a = 2 / 1       '││
    Debug.Print "C" '││
Exit Sub            '││
    Debug.Print "D" '││
Jump: '───────┘│
    Debug.Print "E" '  │
Resume Next '─────┘
    Debug.Print "F"
'A
'E
'B
'C

End Sub

この例では、エラー処理コードは Exit Sub ステートメントと End Sub ステートメントの間にあり、通常のプロシージャの流れから区切られています。
エラーを処理するためのコードは、プロシージャ内の任意の場所に配置できます。
オブジェクトを実行可能ファイルとして実行しているときにオブジェクトでトラップできないエラーが発生すると、制御側のアプリケーションにエラーが返されます。開発環境では、トラップできないエラーは、適切にオプションが設定されている場合のみ制御側のアプリケーションに返されます。
使用しているホストアプリケーションのマニュアルでデバッグ時にどのオプションを設定する必要があるのか、オプションの設定方法、およびホストアプリケーションがクラスを作成できるかどうかを参照してください。
他のオブジェクトを操作するオブジェクトを作成する場合、他のオブジェクトから未処理のまま返されるエラーを処理する必要があります。
このようなエラーを処理できない場合は、Err オブジェクトの Number プロパティを使用して作成したエラーの 1 つにエラーコードを割り当てます。
次に、作成したオブジェクトを呼び出しているアプリケーションにエラーを引き渡します。エラーを指定するには、エラーコードを定数 vbObjectError に追加します。
たとえば、エラーコードが 1052 であれば、次のように代入します。

Err.Number = vbObjectError + 1052
メモ
ダイナミックリンクライブラリ (DLL)または Macintosh のコードリソースを呼び出しているときに発生するエラーは、Visual Basic のエラートラップではトラップされません。
DLL 関数を呼び出す場合、各関数の戻り値を API の仕様を基に確認し、処理が完了したかどうか、または失敗したかどうかを判断します。
次に、エラーが発生したイベントで Err オブジェクトの LastDLLError プロパティの値を確認します。
Macintosh では、LastDLLError プロパティは、常に 0 の値を返します。

Resume ステートメント

エラー処理ルーチンの終了後に、プログラムの実行を再開します。

構文
Resume [0]
Resume Next
Resume line
Resume ステートメントの構文の形式は次のとおりです。
ステートメント内容
Resume [0]
エラー処理ルーチンと同じプロシージャ内でエラーが発生した場合、エラーの原因となったステートメントからプログラムの実行が再開されます。
呼び出されたプロシージャ内でエラーが発生した場合、エラー処理ルーチンを含むプロシージャが最後に呼び出したステートメントからプログラムの実行が再開されます。
Resume Next
エラー処理ルーチンと同じプロシージャ内でエラーが発生した場合、エラーの原因となったステートメントの次のステートメントからプログラムの実行が再開されます。
呼び出されたプロシージャ内でエラーが発生した場合、エラー処理ルーチンを含むプロシージャが最後に呼び出したステートメントの次のステートメント、または On Error Resume Next ステートメントからプログラムの実行が再開されます。
Resume line
引数 line に指定した行からプログラムの実行が再開されます。
引数 line は必ず指定します。引数 line には行ラベルまたは行番号を指定します。
また、エラー処理ルーチンと同じプロシージャに指定する必要があります。
解説
エラー処理ルーチン以外の場所で Resume ステートメントを使用すると、エラーが発生します。

On Error ステートメントResume ステートメントの使用例

Option Explicit

Private Sub test1()
'*******************
'On Error GoTo line
'*******************

Dim a As Double, b As Byte
b = 1
    Debug.Print "①"
On Error GoTo Jump
    a = 2 / 0
    Debug.Print "②"
    a = 2 / b
    Debug.Print "③"
Exit Sub
    Debug.Print "④"
Jump:
    Debug.Print "⑤"
Resume Next
    Debug.Print "⑥"
'①
'⑤
'②
'③
End Sub

Private Sub test2()
'*******************
'On Error Resume Next
'*******************

Dim a As Double, b As Byte
b = 1
    Debug.Print "①"
On Error Resume Next
    a = 2 / 0
    Debug.Print "②"
    a = 2 / b
    Debug.Print "③"
Exit Sub
    Debug.Print "④"

'①
'②
'③
End Sub

Private Sub test3()
'*******************
'On Error GoTo 0
'*******************

Dim a As Double

    Debug.Print "①"
On Error Resume Next
    a = 2 / 0
    Debug.Print "②"
On Error GoTo 0
    Debug.Print "③"
On Error Resume Next
    Debug.Print "④"
    a = 2 / 0
    Debug.Print "⑤"
Exit Sub
    Debug.Print "⑥"
'①
'②
'③
'④
'⑤
End Sub

Private Sub testA()
'*******************
'Resume [0]
'*******************

Dim a As Double, b As Byte
b = 0
    Debug.Print "①"
On Error GoTo Jump
    a = 2 / b
    Debug.Print "②"
    b = b - 1
    a = 2 / b
    Debug.Print "③"
Exit Sub
    Debug.Print "④"
Jump:
    Debug.Print "⑤"
    b = b + 1
Resume
    Debug.Print "⑥"
'①
'⑤
'②
'⑤
'③
End Sub

Private Sub testB()
'*******************
'Resume Next
'*******************

Dim a As Double, b As Byte
b = 1
    Debug.Print "①"
On Error GoTo Jump
    a = 2 / 0
    Debug.Print "②"
    a = 2 / b
    Debug.Print "③"
Exit Sub
    Debug.Print "④"
Jump:
    Debug.Print "⑤"
Resume Next
    Debug.Print "⑥"
'①
'⑤
'②
'③
End Sub

Private Sub testC()
'*******************
'Resume line
'*******************

Dim a As Double, b As Byte
b = 1
    Debug.Print "①"
On Error GoTo Jump
    a = 2 / 0
ReTry:
    Debug.Print "②"
    a = 2 / b
    Debug.Print "③"
Exit Sub
    Debug.Print "④"
Jump:
    Debug.Print "⑤"
Resume ReTry
    Debug.Print "⑥"
'①
'⑤
'②
'③
End Sub

コントロールコンボボックス（3列目がカナ設定）フリガナ順ソート

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Sub コンボ昇順(obj As ComboBox)
'*******************************************************************************
'コンボ（3列目がカナ設定）フリガナ順ソート
'*******************************************************************************
Dim n As Long, i As Long, m As String, s As Long, j As Long, t(3) As String
Dim Data(), a As Long, b As Byte

      n = obj.ListCount
      ReDim Data(n, 3)
      For a = 1 To n
            For b = 1 To 3
                  Data(a, b) = obj.List(a - 1, b - 1)
            Next b
      Next a

    For i = 2 To n - 1 '1は項目
        m = Data(i, 3)
        s = i

        For j = i + 1 To n
            If Data(j, 3) < m Then
                m = Data(j, 3)
                s = j
            End If
        Next j

        t(3) = Data(i, 3): t(2) = Data(i, 2): t(1) = Data(i, 1)
        Data(i, 3) = Data(s, 3): Data(i, 2) = Data(s, 2): Data(i, 1) = Data(s, 1)
        Data(s, 3) = t(3): Data(s, 2) = t(2): Data(s, 1) = t(1)
    Next i
    obj.Clear

      For a = 1 To n
                  obj.AddItem Data(a, 1)
            For b = 2 To 3
                  obj.List(a - 1, b - 1) = Data(a, b)
            Next b
      Next a

End Sub

FSO 指定フォルダ指定ファイル削除・このサンプルでは[Thumbs.db]を削除しています。

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub 指定フォルダ指定ファイル削除()
'***********************************
'指定フォルダ指定ファイル削除
'***********************************
'指定フォルダ内のファルダを含むフォルダ内の特定ファイルを削除する
'指定フォルダを含む2階層まで検索
'このサンプルでは[Thumbs.db]を削除しています。

Dim strFilePath As String
Dim objFSO As Object
Dim strOpenPath As String
Dim objFolder As Object
Dim objSubFolder As Object
Dim objFile As Object
Dim strFileName As String
Dim GetFileName As String
Dim lngCnt As Long

GetFileName = "Thumbs" '検索するファイル名

lngCnt = 0
strOpenPath = ThisWorkbook.Path

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strOpenPath)

    'フォルダ直下
    For Each objFile In objFolder.Files
        strFilePath = objFile.Path
        strFileName = objFSO.GetFileName(strFilePath)
            If InStr(1, strFileName, GetFileName) <> 0 Then
                If MsgBox(strFilePath & vbNewLine & "Delete?", vbOKCancel, strFileName) = vbOK Then
                lngCnt = lngCnt + 1
                '[Kill]関数では"Thumbs.db"等の特殊ファイルは削除不可
                    objFSO.GetFile(strFilePath).Delete
                End If
            End If
    Next

    'サブフォルダ
    For Each objSubFolder In objFolder.SubFolders
        For Each objFile In objSubFolder.Files
            strFilePath = objFile.Path
            strFileName = objFSO.GetFileName(strFilePath)
                If InStr(1, strFileName, GetFileName) <> 0 Then
                    If MsgBox(strFilePath & vbNewLine & "Delete?", vbOKCancel, strFileName) = vbOK Then
                    lngCnt = lngCnt + 1
                    '[Kill]関数では"Thumbs.db"等の特殊ファイルは削除不可
                        objFSO.GetFile(strFilePath).Delete
                    End If
                End If
        Next
    Next

Set objFSO = Nothing

MsgBox "処理終了" & vbNewLine & lngCnt & " 個のファイルを削除しました。", 0, "処理終了"

End Sub

FSO 指定したドライブの種類を判別する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FSODriveInfo(ByVal Drvpath As String)
'********************************************
'FSO 指定したドライブの種類を判別する
'********************************************

Dim fso, d, s, t
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(Drvpath)))
    Select Case d.DriveType
        Case 0: t = "不明"
        Case 1: t = "リムーバブルディスク"
        Case 2: t = "ハードディスク"
        Case 3: t = "ネットワークディスク"
        Case 4: t = "CD-ROM"
        Case 5: t = "RAM ディスク"
    End Select
s = Drvpath & " = DriveLetter:"
s = s & d.DriveLetter & ",DriveType: " & d.DriveType & "(" & t & ")"
s = s & ",SerialNumber: " & d.SerialNumber
FSODriveInfo = s

End Function

Private Sub test()
FSOSetDLL 'FSO参照設定
Debug.Print FSODriveInfo("D:\")
'D:\ = DriveLetter:D,DriveType: 4(CD-ROM),SerialNumber: -999999999
End Sub

FSO 指定したファイルの読取・追加・書込をするFSOTextFile

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FSOTextFile(ByVal TxtPath As String, ByVal Character As String)
'****************************************************************
'FSO 指定したファイルの読取・追加・書込をするFSOTextFile
'****************************************************************
'
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim Fso, f
Set Fso = CreateObject("Scripting.FileSystemObject")
Set f = Fso.OpenTextFile(TxtPath, ForWriting, True)
f.Write Character
f.Close
End Sub

Private Sub test()
FSOSetDLL 'FSO参照設定
Dim p As String
Dim m As String
Dim s As String
p = ThisWorkbook.Path
m = "test.txt"
s = "テスト"
Call FSOTextFile(p & "\" & m, s)
'テスト
End Sub

FSO 指定されたフォルダ内に置かれているすべてのフォルダの入ったFoldersコレクションを取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ShowFolderList(folderspec)
'*****************************************************
'指定されたフォルダ内に置かれているすべてのフォルダの
'入った Folders コレクションを返す
'*****************************************************
    Dim fs, f, f1, s, sf
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set sf = f.SubFolders
    For Each f1 In sf
        s = s & f1.Name
        s = s & vbCrLf
    Next
    MsgBox s
End Sub

FSO 指定されたドライブのネットワーク共有名を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FSODriveInfoShareName(ByVal drvpath As String)
'***********************************************
'FSO 指定されたドライブのネットワーク共有名を取得
'***********************************************

Dim Fso, d
Set Fso = CreateObject("Scripting.FileSystemObject")
Set d = Fso.GetDrive(Fso.GetDriveName(Fso.GetAbsolutePathName(drvpath)))
FSODriveInfoShareName = d.DriveLetter & ": ShareName: " & d.ShareName
End Function

Private Sub test()
FSOSetDLL 'FSO参照設定
Debug.Print FSODriveInfoShareName("C:\")
'C: ShareName: MSXXXXXX
End Sub

FSO 指定したディレクトリ内のすべてのサブフォルダを取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub 指定フォルダサブフォルダ取得()
'***************************************************
'指定したディレクトリ内のすべてのサブフォルダを取得
'***************************************************
'*Visual Basic 6.0 及び VBA
'*[参照設定] 「Microsoft Scripting Runtime」チェック
'*FileSystemObject の SubFolders メソッド

Dim lIndex As Long
Dim hFolder As Folder
Dim subFolder As Folder
Dim Fso As FileSystemObject

Set Fso = New FileSystemObject
Set hFolder = Fso.GetFolder(ThisWorkbook.Path & "\")

    lIndex = 1 '(使用により数値を変更)
        For Each subFolder In hFolder.SubFolders
'            Debug.Print subFolder.Path’フルパス＆フォルダ名の場合
            Debug.Print subFolder.Name 'フォルダ名のみの場合
            lIndex = lIndex + 1
        Next subFolder

Set Fso = Nothing
Set subFolder = Nothing
Set hFolder = Nothing

End Sub

FSO ファイルの種類に関する情報を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FSOFileType(ByVal FilePath As String)
'**************************************************
'FSO ファイルの種類に関する情報を取得
'**************************************************
'パスはファイルを指定
'該当パスが無い場合はエラーになります。

Dim Fso, f, s
Set Fso = CreateObject("Scripting.FileSystemObject")
Set f = Fso.GetFile(FilePath)
FSOFileType = f.Type
End Function

Private Sub test()
FSOSetDLL 'FSO参照設定
Dim p As String
Dim m As String
p = ThisWorkbook.Path
m = ThisWorkbook.Name
Debug.Print FSOFileType(p & "\" & m)
'Microsoft Excel ワークシート
End Sub

FSO サブフォルダ含めすべて取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub GetFolderAndFile()
'*****************************************************************
'指定したディレクトリ内のすべてのサブフォルダ及びファイルを取得
'*****************************************************************
'*２層以下は取得しません
'*Visual Basic 6.0 及び VBA
'*Microsoft Scripting Runtime(FSO)要参照設定
'EXCEL.BOOK新しいシートを追加しそこに列挙

Dim sht As Worksheet
Dim lIndex As Long
Dim hFolder As Folder
Dim subFolder As Folder
Dim Fso As FileSystemObject
Dim hFile As File
Dim iFolder As Folder

Set Fso = New FileSystemObject
Set hFolder = Fso.GetFolder(ThisWorkbook.Path & "\")
Set sht = ThisWorkbook.Worksheets.Add

With sht
'1.直下のファイル名取得(この場合このコードが実装されているファイル名が入る）
    lIndex = 1
        For Each hFile In hFolder.Files
            .Cells(lIndex, 1).Value = hFile.Name 'ファイル名のみの場合
            lIndex = lIndex + 1
        Next hFile

'2.直下のフォルダ名及びファイル名取得
        For Each subFolder In hFolder.SubFolders
            .Cells(lIndex, 2).Value = "[" & subFolder.Name & "]"
            lIndex = lIndex + 1
            Set iFolder = Fso.GetFolder(subFolder.Path & "\")
                For Each hFile In iFolder.Files
                    .Cells(lIndex, 3).Value = hFile.Name
                    lIndex = lIndex + 1
                Next hFile
            Set iFolder = Nothing
        Next subFolder
End With

Set Fso = Nothing
Set subFolder = Nothing
Set hFolder = Nothing
Set hFile = Nothing
Set sht = Nothing

End Sub

FSO OpenAsTextStreamメソッド定数とサンプルコード

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

OpenAsTextStream メソッド

指定したファイルを開き、開いたファイルの読み取り、または追加書き込みに使用できる TextStream オブジェクトを返します。

object.OpenAsTextStream([iomode, [format]])
引数
object
必ず指定します。File オブジェクトの名前を指定します。
iomode
省略可能です。入出力モードを指定します。指定する値については、次の「設定値」を参照してください。
format
省略可能です。開くファイルの形式を示す値を指定します。指定する値については、次の「設定値」を参照してください。省略した場合、ASCII ファイルとしてファイルが開かれます。
設定値

引数 iomode の設定値は次のとおりです。

定数	値	内容
ForReading	1	ファイルを読み取り専用として開きます。このファイルには書き込むことができません。
ForWriting	2	ファイルを書き込み専用として開きます。既存ファイルがある場合、以前の内容は上書きされます。
ForAppending	8	ファイルを開き、ファイルの最後に追加して書き込みます。

引数 format の設定値は次のとおりです。

定数	値	内容
TristateUseDefault	-2	システムデフォルトを使ってファイルを開きます。
TristateTrue	-1	ファイルを Unicode ファイルとして開きます。
TristateFalse	0	ファイルを ASCII ファイルとして開きます。

解説

OpenAsTextStream メソッドは、FileSystemObject オブジェクトの OpenTextFile メソッドとほぼ同じ機能を提供します。OpenTextFile メソッドと異なるのは、ファイルを追加書き込みではなく書き込み専用に開くことができます。

サンプル

Option Explicit

Function FSOTextStream(ByVal txtPath As String, ByVal Character As String)
'*******************************************
'指定したファイルの読取・追加・書込をする
'*******************************************

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fso, f, ts

Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile txtPath ' Create a file.
Set f = fso.GetFile(txtPath)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
ts.Write Character
ts.Close
Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
FSOTextStream = ts.ReadLine
ts.Close

End Function

Private Sub test()
FSOSetDLL 'FSO参照設定
Dim p As String
Dim m As String
Dim s As String
p = ThisWorkbook.Path
m = "test.txt"
s = "テスト"
Debug.Print FSOTextStream(p & "\" & m, s)
'テスト
End Sub

FSO OpenTextFileメソッド定数とサンプルコード

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

OpenTextFile メソッド

指定したファイルを開き、開いたファイルの読み取り、または追加書き込みに使用できる TextStream オブジェクトを返します。

object.OpenTextFile(filename[, iomode[, create[, format]]])
引数
object
必ず指定します。FileSystemObject オブジェクトの名前を指定します。
filename
必ず指定します。作成するファイルの名前を表す文字列式を指定します。
iomode
省略可能です。指定する値については、次の「設定値」を参照してください。
create
省略可能です。引数 filename で指定したファイルが存在しなかった場合に新しいファイルを作成するかどうかを示すブール値を指定します。新しいファイルを作成する場合は真 (true) を、ファイルを作成しない場合は偽 (false) を指定します。省略した場合、新しくファイルは作成されません。
format
省略可能です。開くファイルの形式を示す値を指定します。指定する値については、次の「設定値」を参照してください。省略した場合、ASCII ファイルとしてファイルが開かれます。
設定値

引数 iomode の設定値は次のとおりです。

定数	値	内容
ForReading	1	ファイルを読み取り専用として開きます。このファイルには書き込むことができません。
ForWriting	2	ファイルを書き込み専用として開きます。
ForAppending	8	ファイルを開き、ファイルの最後に追加して書き込みます。

引数 format の設定値は次のとおりです。

値	内容
TristateTrue	ファイルを Unicode ファイルとして開きます。
TristateFalse	ファイルを ASCII ファイルとして開きます。
TristateUseDefault	システムデフォルトを使ってファイルを開きます。

解説

次のコードは、OpenTextFile メソッドを使用して、テキストを追加するためにファイルを開く方法を示します。

サンプルコード

Option Explicit

Sub FSOTextFile(ByVal txtPath As String, ByVal Character As String)
'****************************************************************
'FSO 指定したファイルの読取・追加・書込をするFSOTextFile
'****************************************************************

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(txtPath, ForWriting, True)
f.Write Character
f.Close
End Sub

Private Sub test()
FSOSetDLL 'FSO参照設定
Dim p As String
Dim m As String
Dim s As String
p = ThisWorkbook.Path
m = "test.txt"
s = "テスト"
Call FSOTextFile(p & "\" & m, s)
'テスト
End Sub

FSO フォルダ名変更指定文字を先頭に付加させる

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub SetScrrunDLL()
'*****************************************************
'このコードが実装されたブックが「FileSystemObject」
'が使えるように参照設定をする。
'*****************************************************
On Error GoTo MyERROE:
'参照設定
ThisWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\system32\scrrun.dll"
MyERROE:
End Sub

Sub フォルダ名変更()
'*****************************************************
'指定文字を先頭に付加(追加)させる
'*****************************************************
'対象は同階層フォルダ
'結果を新しいシートを追加し一覧表示

Dim Fso As FileSystemObject
Dim sht As Worksheet, Nsht As Worksheet
Dim lIndex As Long
Dim hFolder As Folder
Dim subFolder As Folder
Dim FukaName As String
Dim MotoName As String
Dim PathName As String

Set Fso = New FileSystemObject
Set hFolder = Fso.GetFolder(ThisWorkbook.Path & "\")
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set Nsht = ThisWorkbook.Worksheets.Add

PathName = ThisWorkbook.Path & "\"

With sht
    FukaName = .Cells(2, 1).Value
End With

With Nsht
    .Cells.ClearContents
    lIndex = 0
        lIndex = lIndex + 1
        .Cells(lIndex, 1).Value = "Index"
        .Cells(lIndex, 2).Value = "旧名"
        .Cells(lIndex, 3).Value = "新名"
        For Each subFolder In hFolder.SubFolders
            lIndex = lIndex + 1
            .Cells(lIndex, 1).Value = lIndex - 1
            MotoName = subFolder.Name
            .Cells(lIndex, 2).Value = MotoName

            Set Fso = CreateObject("Scripting.FileSystemObject")
            'フォルダの名前を変更
            Fso.GetFolder(PathName & MotoName).Name = FukaName & MotoName
            Set Fso = Nothing

            .Cells(lIndex, 3).Value = FukaName & MotoName
        Next subFolder
End With

Set Fso = Nothing
Set hFolder = Nothing
Set sht = Nothing

MsgBox "END"
End Sub

FSO フォルダの種類に関する情報を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FSOFolderType(ByVal FolderPath As String)
'**************************************************
'FSO フォルダの種類に関する情報を取得
'**************************************************
'パスはフォルダを指定
'該当パスが無い場合はエラーになります。

Dim Fso, f, s
Set Fso = CreateObject("Scripting.FileSystemObject")
Set f = Fso.GetFolder(FolderPath)
FSOFolderType = f.Type
End Function

Private Sub test()
FSOSetDLL 'FSO参照設定
Dim p As String
p = ThisWorkbook.Path
Debug.Print FSOFolderType(p)
'ファイルフォルダ
End Sub

FSO フォルダ名変更先頭から文字数指定しフォルダ名を変更する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub フォルダ名変更()
'*****************************************************
'先頭から文字数指定しフォルダ名を変更する
'*****************************************************
'対象は同階層フォルダ
'結果を新しいシートを追加し一覧表示

Dim Fso As FileSystemObject
Dim sht As Worksheet, Nsht As Worksheet
Dim lIndex As Long
Dim hFolder As Folder
Dim subFolder As Folder
Dim cntdel As Long
Dim MotoName As String
Dim PathName As String

Set Fso = New FileSystemObject
Set hFolder = Fso.GetFolder(ThisWorkbook.Path & "\")
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set Nsht = ThisWorkbook.Worksheets.Add

PathName = ThisWorkbook.Path & "\"

With sht
    cntdel = .Cells(2, 1).Value
End With

With Nsht
    .Cells.ClearContents
    lIndex = 0
        lIndex = lIndex + 1
        .Cells(lIndex, 1).Value = "Index"
        .Cells(lIndex, 2).Value = "旧名"
        .Cells(lIndex, 3).Value = "新名"
        For Each subFolder In hFolder.SubFolders
            lIndex = lIndex + 1
            .Cells(lIndex, 1).Value = lIndex - 1
            MotoName = subFolder.Name
            .Cells(lIndex, 2).Value = MotoName

            Set Fso = CreateObject("Scripting.FileSystemObject")
            'フォルダの名前を変更
            Fso.GetFolder(PathName & MotoName).Name = Mid(MotoName, cntdel + 1)
            Set Fso = Nothing

            .Cells(lIndex, 3).Value = Mid(MotoName, cntdel + 1)
        Next subFolder
End With

Set Fso = Nothing
Set hFolder = Nothing
Set sht = Nothing

MsgBox "END"
End Sub

WEB HTML形式のテーブル（表）の値を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit
'**************************************************
'HTML形式のテーブル（表）の値を取得する
'**************************************************
'1.ユーザーフォームを設置　UserForm1
'2.テキストボックスを設置　TextBox1
'3.コマンドボタンを設置　CommandButton1
'4.WebBrowserを設置　WebBrowser1

'**************************************************
'フォーム上のブラウザに指定アドレス先を表示
'**************************************************
Private Sub CommandButton1_Click()
Me.WebBrowser1.Navigate Trim(Me.TextBox1.Value)
End Sub

'**************************************************
'読み込み（ＤＬ）が完了後発生するイベント
'**************************************************
'注意：テーブルエレメントは行も列も「0」から始まります。
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Dim sht As Worksheet, cnt As Long
Dim cnty As Long, str As String

'抽出した値を格納するシートを指定
Set sht = ThisWorkbook.Worksheets("Sheet4")

Dim objTable As Object
Dim 全テーブル数 As Long
Dim 該当テーブル番号 As Long
Dim 行数 As Long, x As Long
Dim 列数 As Long, y As Long
Dim テキスト As String
Dim 目的タイトル As String

    'ＨＴＭＬドキュメントのテーブルタグをオブジェクトにセット
    Set objTable = Me.WebBrowser1.Document.getElementsByTagName("TABLE")

    'TABLEが無い場合
    If objTable Is Nothing Then
        Set objTable = Nothing
        MsgBox "TABLE Object Nothing!"
        Exit Sub
    End If

    'TABLEが無い場合
    If objTable.Length = 0 Then
        Set objTable = Nothing
        MsgBox "TABLE Object 全テーブル数 = 0!"
        Exit Sub
    Else
        全テーブル数 = objTable.Length - 1
    End If

    '全テキストのみ抽出（因みに）
    テキスト = objTable(0).Rows(0).Cells(0).innerText

    '目的のテーブル番号指定
    該当テーブル番号 = 7

    str = objTable(該当テーブル番号).Rows(0).Cells(0).innerText

    目的タイトル = Trim(Mid(str, 1, InStr(1, str, "[") - 1))

    '目的のテーブル番号指定
    該当テーブル番号 = 11

    '目的のテーブル行数取得
    行数 = objTable(該当テーブル番号).Rows.Length - 1 '縦数

    'エラー回避
    If 行数 < 0 Then
        MsgBox "TABLE Object ERR!"
        Exit Sub
    End If

        '(項目行必要の場合は0から始める)
        '(項目行不要の場合は1から始める)
        For x = 1 To 行数
            '目的のテーブル列数取得
            列数 = objTable(該当テーブル番号).Rows(x).Cells.Length - 1
                'エラー回避
                If 列数 < 0 Then
                    MsgBox "TABLE Object ERR!"
                    Exit Sub
                End If

            '書き込むシートの最終行取得
            cnt = sht.Cells(65536, 1).End(xlUp).Row + 1
            'シート書き込み用列番号を初期化
            cnty = 0
            cnty = cnty + 1
            sht.Cells(cnt, cnty).Value = 目的タイトル
            For y = 0 To 列数
                cnty = cnty + 1
                テキスト = objTable(該当テーブル番号).Rows(x).Cells(y).innerText
                Debug.Print "テ[" & 該当テーブル番号 & "]" & "行[" & x & "]" & "列[" & y & "]:" & テキスト
                sht.Cells(cnt, cnty).Value = Trim(テキスト)
            Next y
        Next x

    Set objTable = Nothing

End Sub

WEB APIを使用しWeb上のファイルをダウンロードする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'[Microsoft Support]参照
'http://support.microsoft.com/kb/q244757/

Sub DownloadFile(strDLWWWPath As String, strDLFileName As String)
'*********************************************
'APIを使用しWeb上のファイルをダウンロードする
'*********************************************
'予め直下に「DownloadFile」フォルダを作成しておく

Dim Ret As Long
Dim strLocalPath As String

strLocalPath = ThisWorkbook.Path & "\" & "DownloadFile" & "\" & strDLFileName
'                                        ~~~~~~~~~~~~~~予め作成しておく
Ret = URLDownloadToFile(0, strDLWWWPath & "/" & strDLFileName, strLocalPath, 0, 0)

    If Ret <> 0 Then
        MsgBox "Download Error!", 48, strDLFileName
    Else
        MsgBox strDLFileName & " -Finish!", strDLFileName
    End If

'APPLIES TO
    'Microsoft Internet Explorer 4.0 128-Bit Edition
    'Microsoft Internet Explorer 4.01 Service Pack 2
    'Microsoft Internet Explorer 4.01 Service Pack 1
    'Microsoft Internet Explorer 5.0
    'Microsoft Internet Explorer 5.01
    'Microsoft Internet Explorer 5.5
    'Microsoft Visual Basic 5.0 Learning Edition
    'Microsoft Visual Basic 6.0 Learning Edition
    'Microsoft Visual Basic 5.0 Professional Edition
    'Microsoft Visual Basic 6.0 Professional Edition
    'Microsoft Visual Basic 5.0 Enterprise Edition
    'Microsoft Visual Basic Enterprise Edition for Windows 6.0
End Sub

Private Sub test()
DownloadFile "http://www.jp-ia.com/_ans", "file86.htm"
End Sub

WEB HTMLファイルのリンクページを作成

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub HTMLFileAdd()
'*********************
'HTMLファイル作成
'*********************

Dim MyFile As String
Dim My_Title As String
Dim SubTitle() As String
Dim MyURL() As String
Dim MyName() As String
Dim x As Long
Dim y As Long

MyFile = ThisWorkbook.Path & "\test\test1.html"

Open MyFile For Output As #1

My_Title = "情報処理"

Print #1, "<TABLE border=""4"" width=""640"" cellpadding=""2"">"
Print #1, " <TBODY>"
Print #1, " <TR>"
Print #1, " <TD colspan=""2"" bgcolor=""#000099"">"
Print #1, "<FONT size=""-1"" color=""#ffffff"">" & My_Title & "</FONT></TD>"

y = 20

For x = 1 To y

ReDim SubTitle(y) As String
ReDim MyURL(y) As String
ReDim MyName(y) As String

SubTitle(x) = "情報処理" & x
MyURL(x) = "http://www.jp-ia.com/"
MyName(x) = "JPIACOM" & x

Print #1, " <TR>"
Print #1, " <TD><FONT size=""-1"">" & SubTitle(x) & "</FONT></TD>"
Print #1, " <TD><FONT size=""-1""><A href=""" & MyURL(x) & """>" & MyName(x) & "</A></FONT></TD></TR>"

Next x

'Print #1, " </TBODY>"
'Print #1, "</TABLE>"

Close #1

End Sub

FSO 指定ルートの配下全て(深階層まで)のファルダパスとフォルダ名取得(深階層まで)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'**************************************************
'配下全てのThumbs.dbを削除するサンプル例
'**************************************************

Private lngRootCnt As Long
Private objFSO As Object
Private GetFileName As String '*処理
Private lngCnt As Long '*処理

Private Sub MakeSubFolderList()
'**************************************************
'指定ルートの配下全てのファルダパスとフォルダ名取得
'**************************************************

GetFileName = "Thumbs.db" '検索するファイル名'*処理

Dim strStartRoot As String

Set objFSO = New FileSystemObject

strStartRoot = ThisWorkbook.Path

lngRootCnt = 1

'再帰処理の為、サブルーチンをコールします
Call SubFolderSearch(strStartRoot)

Set objFSO = Nothing

End Sub

Private Sub SubFolderSearch(StartFolderPath As String)
'**************************************************
'フォルダパス及びフォルダ名取得再帰処理
'**************************************************
'無限ループ処理の為、フォルダやファイルの削除など行う場合は
'必ずバックアップを行って下さい。
'追加処理をした場合ＰＣのハングアップの危険もあります。
'一応動作確認は行ってます。

Dim SearchMainFolder As Folder
Dim SearchSubFolderA As Folder
Dim SearchSubFolderB As Folder

Dim objFolder As Object '*処理
Dim objFile As Object '*処理
Dim strFilePath As String '*処理
Dim strFileName As String '*処理

    '*処理---------------------------------------------------------------/
    'フォルダ直下
    With objFSO
    Set objFolder = .GetFolder(StartFolderPath)
    For Each objFile In objFolder.Files
        strFilePath = objFile.Path
        strFileName = .GetFileName(strFilePath)
            If InStr(1, strFileName, GetFileName) <> 0 Then
                If MsgBox(strFilePath & vbNewLine & "Delete?", vbOKCancel, strFileName) = vbOK Then
                lngCnt = lngCnt + 1 '処理数
                '[Kill]関数では"Thumbs.db"等の特殊ファイルは削除不可
                    .GetFile(strFilePath).Delete
                End If
            End If
    Next
    Set objFolder = Nothing
    End With
    '*処理---------------------------------------------------------------/

    'フォルダ数
    lngRootCnt = lngRootCnt + 1

    With objFSO

        Set SearchMainFolder = .GetFolder(StartFolderPath)

        For Each SearchSubFolderA In SearchMainFolder.SubFolders

            '*処理---------------------------------------------------------------/
            'フォルダ直下
            Set objFolder = .GetFolder(SearchSubFolderA)
            For Each objFile In objFolder.Files
                strFilePath = objFile.Path
                strFileName = .GetFileName(strFilePath)
                    If InStr(1, strFileName, GetFileName) <> 0 Then
                        If MsgBox(strFilePath & vbNewLine & "Delete?", vbOKCancel, strFileName) = vbOK Then
                        lngCnt = lngCnt + 1 '処理数
                        '[Kill]関数では"Thumbs.db"等の特殊ファイルは削除不可
                            .GetFile(strFilePath).Delete
                        End If
                    End If
            Next
            Set objFolder = Nothing
            '*処理---------------------------------------------------------------/

            'フォルダ数
            lngRootCnt = lngRootCnt + 1

            If SearchSubFolderA.SubFolders.Count > 0 Then

                For Each SearchSubFolderB In SearchSubFolderA.SubFolders

                    Call SubFolderSearch(SearchSubFolderB.Path)

                Next SearchSubFolderB

            End If
        Next SearchSubFolderA

    End With

Set SearchMainFolder = Nothing
Set SearchSubFolderA = Nothing
Set SearchSubFolderB = Nothing

End Sub

FSO 指定フォルダ内のサブフォルダとファイル(詳細)を列挙(深階層)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'Microsoft Scripting Runtime(FSO)

Dim sht As Worksheet, cntLow As Long
Dim strExtension As String, lngSize As Long
Dim objMsSR As Object

Sub GetAllSubFolderAndFiles()
'************************************************************
'指定フォルダ内のサブフォルダとファイル(詳細)を列挙(深階層)
'************************************************************

strExtension = "jpg" '*拡張子指定
lngSize = 100 '*サイズ指定

Dim objGFld As Object
Dim strFolderPath As String

strFolderPath = ThisWorkbook.Path
Set sht = ThisWorkbook.Worksheets.Add
Set objMsSR = CreateObject("Scripting.FileSystemObject")
'GetFolderメソッド
Set objGFld = objMsSR.GetFolder(strFolderPath)

cntLow = cntLow + 1
With sht
    sht.Cells(cntLow, 1).Value = "FolderName"
    sht.Cells(cntLow, 2).Value = "FileName"
    sht.Cells(cntLow, 3).Value = "FileSize"
    sht.Cells(cntLow, 4).Value = "作成日時"
    sht.Cells(cntLow, 5).Value = "更新日時"
    sht.Cells(cntLow, 6).Value = "アクセス日時"
    sht.Cells(cntLow, 7).Value = "FolderSize"
End With

'サブルーチン
Call SearchSubFolderAndFiles(objGFld)

Set objMsSR = Nothing

MsgBox "END"

End Sub

Private Sub SearchSubFolderAndFiles(objMainFld As Folder)
'****************
'サブルーチン
'****************
Dim objFld As Folder
Dim objFile As File
Dim strFldName As String
Dim strFldSize As String

strFldName = objMainFld.Name

'ドライブ・ディスクを回避(受付)
If strFldName = "" And objMainFld.Attributes = 22 Then
    '22=Hidden(2)+System(4)+Directory(16)
    For Each objFld In objMainFld.SubFolders
        Call SearchSubFolderAndFiles(objFld)
    Next objFld
'通常フォルダは全て受け付け
ElseIf objMainFld.Attributes = 16 Then
    '16=Directory(16)
    strFldSize = objMainFld.Size
    For Each objFld In objMainFld.SubFolders
        Call SearchSubFolderAndFiles(objFld)
    Next objFld
Else
    GoTo TheEnd:
End If

For Each objFile In objMainFld.Files
    With objFile
       If objMsSR.GetExtensionName(.Path) = strExtension And .Size > lngSize Then
            cntLow = cntLow + 1
            '●Name プロパティ
            'ファイルまたはフォルダ名の取得
            '●Size プロパティ
            'ファイルバイトサイズ・フォルダ合計バイトサイズの取得
            '●DateCreated プロパティ
            'ファイルまたはフォルダ作成日時の取得
            '●DateLastModified プロパティ
            'ファイルまたはフォルダ更新日時の取得
            '●DateLastAccessed プロパティ
            'ファイルまたはフォルダアクセス日時の取得

            sht.Cells(cntLow, 1).Value = strFldName
            sht.Cells(cntLow, 2).Value = .Name
            sht.Cells(cntLow, 3).Value = .Size
            sht.Cells(cntLow, 4).Value = .DateCreated
            sht.Cells(cntLow, 5).Value = .DateLastModified
            sht.Cells(cntLow, 6).Value = .DateLastAccessed
            sht.Cells(cntLow, 7).Value = strFldSize

        End If
    End With
Next objFile

TheEnd:

Set objMainFld = Nothing

'●Attributesプロパティ
'定数        値内容
'Normal       0 標準ファイル。どの属性も設定されません。
'ReadOnly     1 読み取り専用ファイル。この属性は、値の取得も設定も可能です。
'Hidden       2 隠しファイル。この属性は、値の取得も設定も可能です。
'System       4 システムファイル。この属性は、値の取得も設定も可能です。
'Volume       8 ディスクドライブボリュームラベル。この属性は、値の取得のみ可能です。
'Directory   16 フォルダまたはディレクトリ。この属性は、値の取得のみ可能です。
'Archive     32 ファイルが前回のバックアップ以降に変更されているかどうか。この属性は、値の取得も設定も可能です。
'Alias       64 リンクまたはショートカット。この属性は、値の取得のみ可能です。
'Compressed 128 圧縮ファイル。この属性は、値の取得のみ可能です。

End Sub

'###############################################################################

Sub RuntimeFSOSet()
'*************************************************
'FileSystemObject参照設定
'*************************************************
'名称:Microsoft Scripting Runtime

On Error GoTo MyErr:
'参照設定
ThisWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\system32\scrrun.dll"
MyErr:

End Sub

FSO 従来の8.3形式のファイル名取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FSOFileShortName(ByVal FilePath As String)
'**************************************
'FSO 従来の 8.3 形式のファイル名取得
'**************************************
'パスはファイルを指定
'該当パスが無い場合はエラーになります。
Dim Fso, f, s
Set Fso = CreateObject("Scripting.FileSystemObject")
Set f = Fso.GetFile(FilePath)
s = UCase(f.Name) & " ShortName：" & f.ShortName
FSOFileShortName = s
'UCase 関数
'指定したアルファベットの小文字を大文字に変換する文字列処理関数です｡
'小文字だけが大文字に変換されます｡
'小文字のアルファベット以外の文字は影響を受けません｡

End Function

Private Sub test()
FSOSetDLL 'FSO参照設定
Dim p As String
Dim m As String
p = ThisWorkbook.Path
m = ThisWorkbook.Name
Debug.Print FSOFileShortName(p & "\" & m)
'KEYWORD修正.XLS ShortName：KEYWOR~1.XLS
End Sub

FSO 従来の8.3形式のフォルダ名取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FSOFolderShortName(ByVal FolderPath As String)
'**************************************
'FSO 従来の 8.3 形式のフォルダ名取得
'**************************************
'パスはフォルダを指定
'該当パスが無い場合はエラーになります。
Dim Fso, f, s
Set Fso = CreateObject("Scripting.FileSystemObject")
Set f = Fso.GetFolder(FolderPath)
s = UCase(f.Name) & " ShortName：" & f.ShortName
FSOFolderShortName = s
'UCase 関数
'指定したアルファベットの小文字を大文字に変換する文字列処理関数です｡
'小文字だけが大文字に変換されます｡
'小文字のアルファベット以外の文字は影響を受けません｡

End Function

Private Sub test()
FSOSetDLL 'FSO参照設定
Dim p As String
p = ThisWorkbook.Path
Debug.Print FSOFolderShortName(p)
'コピー～ TES_TGG_XX ShortName：コピー~1
End Sub

WEB Win標準装備FTPexeを使いVBAで操作-2

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

１

アスキーモード（文書ファイル等）
バイナリモード（画像ファイル等）の切り替え

２

ローカル上のアップしたいフォルダに移動してそのファイルをＵＰしています
単一ファイルの場合です

３

アスタリスク*を使用して複数のファイルをＵＰしています。
複数ファイルが大量でも問題ありませんが対話モードの為、ひとつひとつEnterキーが必要です。
この回避方法は後で説明します

４

これも複数のファイルをＵＰしています

５

これは逆にダウンロードしています。
要領は全く同じです。

６

ダウンロードも複数指定できます。

７

これはサーバー上のファイルの名前を変更するコマンドです。

８

これはサーバー上のファイルを削除しています。

９

これはサーバー上にフォルダ（ディレクトリー）を作成し削除しています。

WEB WebBrowserObject

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

※このドキュメントはMicrosoftMSDNサイトを翻訳ソフトで実行し生成されたものです｡
●Events
BeforeNavigate/	操縦の前の発生が、与えられたオブジェクト(ウィンドウまたはframesetの要素上の)の中で起こります。
BeforeNavigate2/	操縦の前の発生が、与えられたオブジェクト(ウィンドウまたはframesetの要素上の)の中で起こります。
ClientToHostWindow/	クライアント・ウィンドウ・サイズがホスト・ウィンドウ・サイズに変換されることを要求する発生。
CommandStateChange/	コマンドの可能になった状態が変わる場合、発生。
DocumentComplete/	ドキュメントが完全にロードされ初期化された場合、発生。
DownloadBegin/	操縦オペレーションが始まる場合、発生。
DownloadComplete/	操縦オペレーションが終了するか停止されるか、失敗する場合、発生。
FileDownload/	ファイル・ダウンロードが生じるところであることを示すために発射します。ファイル・ダウンロード対話が表示されることになっている場合、この出来事は対話のディスプレイに先立って発生されます。
NavigateComplete/	リンクへの操縦の後の発生はウィンドウまたはframeSetの要素上で完成します。
NavigateComplete2/	リンクへの操縦の後の発生はウィンドウまたはframeSetの要素上で完成します。
NavigateError/	エラーが操縦の間に生じる場合、発生。
NewWindow/	新しいウィンドウが作成されることになっている場合、発生。
NewWindow2/	新しいウィンドウが作成されることになっている場合、発生。
PrintTemplateInstantiation/	印刷テンプレートが実証された場合、発生。
PrintTemplateTeardown/	印刷テンプレートが破壊された場合、発生。
PrivacyImpactedStateChange/	それがプライバシーを密着させるか、ユーザがいつ持っているURLから遠ざかって航海するかがプライバシーを密着させたという出来事が生じるとき、発生しました。
ProgressChange/	ダウンロード・オペレーションの進行がオブジェクト上で更新される場合、発生。
SetSecureLockIcon/	暗号化レベルで変更がある場合、発生。
StatusTextChange/	オブジェクトのステータスバー・テキストが変わった場合、発生。
TitleChange/	オブジェクト中のドキュメントのタイトルが利用可能になる場合、発生あるいは変更。
UpdatePageStatus/	なし、現在インプリメントされました。
WindowClosing/	オブジェクトのウィンドウがスクリプトによって閉じられるところの場合、発生。
WindowSetHeight/	オブジェクトがその高さを変更する場合、発生。
WindowSetLeft/	オブジェクトがその左の位置を変更する場合、発生。
WindowSetResizable/	ホスト・ウィンドウがオブジェクトのサイズ変更を可能にするか却下するべきどうか示す発生。
WindowSetTop/	オブジェクトがそのトップの位置を変更する場合、発生。
WindowSetWidth/	オブジェクトがその幅を変更する場合、発生。
●Methods
ExecWB/	OLEオブジェクトに関するコマンドを実行し、IOleCommandTargetインターフェースを使用して、コマンド実行のステータスを返します。
GetProperty/	与えられたオブジェクトに関連した財産の値を検索します。
GoBack/	履歴リスト中の後方への1つのアイテムを航海します。
GoForward/	履歴リスト中の1つのアイテムを前に航海します。
GoHome/	現在の家かスタート・ページへ航海します。
GoSearch/	現在の探索ページに航海します。
Navigate/	URLによって識別された資源に、あるいは十分なパスによって識別されたファイルに航海します。
Navigate2/	マイクロソフトWindowsRシェルnamespaceの中の実体のためにアイテム確認者リスト(PIDL)へのポインターのようなURLとして表現されることができないかもしれない位置へのブラウザーをナビゲートします。
PutProperty/	オブジェクトに関連したプロパティの値をセットします。
Refresh/	オブジェクトに現在表示されるファイルに再びロードします。
Refresh2/	オブジェクトに現在表示されるファイルに再びロードします。リフレッシュと異なり、この方法は、リフレッシュ・レベルを指定するパラメーターを含んでいます。
Stop/	どんな未決の操縦あるいはダウンロード・オペレーションも取り消し、背景音およびアニメーションのようなどんな動的なページ要素も止めます。
●Properties
Application/	WebBrowserコントロールを主催している適用のためのオートメーション・オブジェクトを検索します。
Busy/	オブジェクトが操縦に従事しているかどうか示すか、オペレーションをダウンロードするブール値を検索します。
Container/	コンテナーへのオブジェクト言及を検索します。
Document/	活発なドキュメントのオートメーション・オブジェクトをもしあれば検索します。
Height/	インターネット・エクスプローラー・メイン・ウィンドウの高さをセットするか検索します。
Left/	オブジェクトの主要なウィンドウの左の端のスクリーン座標をセットするか検索します。
LocationName/	インターネット・エクスプローラーが現在表示している資源の名前を検索します。
LocationURL/	インターネット・エクスプローラーが現在表示している資源のURLを検索します。
Offline/	オブジェクトがオフライン・モードで現在作動しているかどうか示す、ブール値をセットするか検索します。
Parent/	オブジェクトの親を検索します。
ReadyState/	オブジェクトの即座の状態を検索します。
RegisterAsBrowser/	目標ネーム・リゾリューションのためのトップレベルのブラウザーとしてオブジェクトが登録されるかどうか示す値をセットするか検索します。
RegisterAsDropTarget/	操縦の低下目標としてオブジェクトが登録されるかどうか示す値をセットするか検索します。
Silent/	オブジェクトがダイアログ・ボックスを示すことができるかどうか示す値をセットするか検索します。
Top/	オブジェクトの主要なウィンドウのトップの端のスクリーン座標をセットするか検索します。
TopLevelContainer/	オブジェクトがトップレベルのコンテナーかどうか示す値を検索します。
Type/	穏やかなドキュメントobject?thatのタイプ名を検索する、ウインドウズHTMLビューアー。
Visible/	オブジェクトが目に見えるか隠されるかどうか示す値をセットするか検索します。
Width/	オブジェクト用の主要なウィンドウの幅をセットするか検索します。

WEB Win標準装備FTPexeを使いVBAで操作-1

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

１

実行ファイルの箇所は　C:\WINDOWS\system32\　にあります。

２

[Windows + R]キーを押して、ファイル名を指定して実行を開きます。

「ftp XXXX.co.jp」のように入力。ＯＫ。

３

デフォルトでは対話モード。

Enterキーを押す毎にFTPexeは返答をします。
因みに220の後にはサーバ名が返ります。
ユーザー名（アカウント）入力。
Enterキー

４

パスワードを求めてきます。
入力。（入力しても表示はされません）
Enterキー

５

すると図のようになります。

接続が完了している。

６

cd www
cdコマンドは後に説明。
意味はカレントディレクトリ。
つまり移動するという意味です。
wwwはディレクトリ名です。
無い場合はエラーになります。
図の上から２番目の★がエラー。

７

今度はlcd XXX
入力
このコマンドはローカル上のカレントディレクトリーを設定（移動）するものです。
要領はcdと同じです。
pwd
は現在のサーバのカレントディレクトリーを表示します。

WEB Win標準装備FTPexeを使いVBAで操作-4

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

１その他のコマンド

現在のFTPexeのステータス（FTP設定状況）です。

FTP設定状況（デフォルト）
設定項目	説明	初期値	コマンド
Type	転送モード	ascii	type ascii binary
Verbose	詳細モード	On	Verbose
Bell	実行完了時「音」	On	bell
Prompting	対話モード	On	prompt
Globbing	ワイルドカード使用	On	glob
Debugging	デバッグモード	Off	debug
Hash mark printing	ＵＰ「#」出力	Off	hash

２

ファイルが見つからない場合のエラーです。

３

ディレクトリ一覧表示作成。
引数にファイル名を指定した場合そのファイルに一覧を記録します。

４

これはローカルカレントフォルダ内のファイル一覧。

５

FTPexeは15分のコマンド入力が無い場合は自動でログアウトします。

WEB Win標準装備FTPexeを使いVBAで操作-3

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

１

これはサーバ上のファイルやフォルダにアクセス権限（パーミッション）を設定しています。
▲　 wwwディレクトリへ移動
▲▲　 test2.htmを664に設定。 664は属性番号をOwner・Group・Othersの順に並べたもの。
▲▲▲　 testというディレクトリを作成。
▲▲▲▲　そのtestフォルダに775のアクセス権限を設定。
詳しくは以下を。

アクセス権(パーミッション[permission])
読込[r]	書込[w]	実行[x]	属性	UNIX形式
TRUE	TRUE	TRUE	7	rwx
TRUE	TRUE	FALSE	6	rw-
TRUE	FALSE	TRUE	5	r-x
TRUE	FALSE	FALSE	4	r--
FALSE	TRUE	TRUE	3	-wx
FALSE	TRUE	FALSE	2	-w-
FALSE	FALSE	TRUE	1	--x
FALSE	FALSE	FALSE	0	---
※TRUE=OK / FALSE=NO

アクセス権(パーミッション[permission])
本人(Owner)	グループ(Group)	他人(Others)
左	中	右

例えば属性[644]ではUNIX形式は[rw-r--r--]になります
動作	本人(Owner)	グループ(Group)	他人(Others)
読込[r]	TRUE	TRUE	TRUE
書込[w]	TRUE	FALSE	FALSE
実行[x]	FALSE	FALSE	FALSE
サーバ上での表記(例)
ファイル　→　-rw-r--r--　１文字目に[-]
ディレクトリ　→　drw-r--r-- １文字目に[d]
※上位の権限を継承するサーバもあります。
例えばあるファイルにアクセス権を設定した場合でもそのファイルの入っているディレクトリ権限が上位権限として適用される。

WEB Win標準装備FTPexeを使いVBAで操作-5

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

MS-DOSコマンドプロンプトでFTPexeを操作する

VBAで操作する前にWindowsに標準装備されているftp.exeを実際に操作してみる。
既にサーバ側にファイルをお持ちの方は実行動作確認テストをしてから行って下さい。

１コマンド一覧

help。
コマンド一覧を表示させるコマンド。

FTPコマンド[MS-DOS]
コマンド	動作	対象	区分	引数	引数
bye	終了	FTP.exe	接続切断終了	-	-
close	切断	サーバ	接続切断終了	-	-
disconnect	切断	サーバ	接続切断終了	-	-
open	接続	サーバ	接続切断終了	ホスト名	ポート番号
quit	切断終了	FTP.exe	接続切断終了	-	-
user	ユーザー名指定	サーバ	接続切断終了	ユーザー名	パスワード
cd	カレントディレクトリ変更	サーバ	ディレクトリ	ディレクトリ名	-
dir	ディレクトリ一覧表示作成	サーバ	ディレクトリ	ディレクトリ名	ファイル名
lcd	カレントディレクトリ変更	ローカル	ディレクトリ	ディレクトリ名	-
ls	ディレクトリ一覧表示作成	サーバ	ディレクトリ	ディレクトリ名	ファイル名
mdir	ディレクトリ一覧表示作成	サーバ	ディレクトリ	ディレクトリ名	ファイル名
mkdir	ディレクトリを作成	サーバ	ディレクトリ	ディレクトリ名	-
mls	ディレクトリ一覧表示作成	サーバ	ディレクトリ	ディレクトリ名	ファイル名
pwd	カレントディレクトリ表示	サーバ	ディレクトリ	-	-
rmdir	ディレクトリ削除（空の場合のみ実行可能）	サーバ	ディレクトリ	ディレクトリ名	-
append	アップロード追加（非対応FTP有り）	サーバ	ファイル	ファイル名	ファイル名
ascii	ASCIIモードに変更	サーバ	モード	-	-
binary	バイナリモードに変更	サーバ	モード	-	-
delete	ファイル削除（単ファイル）	サーバ	ファイル	ファイル名	-
get	ダウンロード（単ファイル）	ローカル	ファイル	ファイル名	ファイル名
literal	引数をリモートマシンに送信	サーバ	ファイル	引数	-
mdelete	ファイル削除（複ファイル対話形式）	サーバ	ファイル	*ファイル名	-
mget	ダウンロード（複ファイル対話形式）	ローカル	ファイル	*ファイル名	-
mput	アップロード（複ファイル対話形式）	サーバ	ファイル	*ファイル名	-
put	アップロード（単ファイル）	サーバ	ファイル	ファイル名	-
quote	引数をリモートマシンに送信	サーバ	ファイル	引数	-
recv	ダウンロード（単ファイル）	ローカル	ファイル	ファイル名	ファイル名
rename	ファイル名変更（単ファイル）	サーバ	ファイル	ファイル名	ファイル名
send	アップロード（単ファイル）	サーバ	ファイル	ファイル名	ファイル名
type	モード	サーバ	モード	ascii	binary
!	コマンドプロンプトへ変更。[exit]で戻る。	FTP.exe	機能	-	-
?	ヘルプを表示。引数で各ヘルプ表示	FTP.exe	機能	コマンド名	-
bell	転送完了時に音を鳴らす	FTP.exe	機能	-	-
debug	デバッグモード	FTP.exe	機能	-	-
glob	ワイルドカード（*,?）使用許可	FTP.exe	機能	-	-
hash	UP/DLの進行状況表示＃	FTP.exe	機能	-	-
help	ヘルプを表示。引数で各ヘルプ表示	FTP.exe	機能	コマンド名	-
prompt	対話式モード	FTP.exe	機能	-	-
remotehelp	ヘルプを表示。引数で各ヘルプ表示	FTP.exe	機能	-	-
status	FTP設定状況	FTP.exe	機能	-	-
trace	パケットトレース機能-有・無効	FTP.exe	機能	-	-
verbose	応答表示	FTP.exe	機能	-	-
全部で４２のコマンドがあります。

２

ファイルが見つからない場合のエラーです。

３

ディレクトリ一覧表示作成。
引数にファイル名を指定した場合そのファイルに一覧を記録します。

４

これはローカルカレントフォルダ内のファイル一覧。

５

FTPexeは15分のコマンド入力が無い場合は自動でログアウトします。

DAO DAOを使いMDBファイルのテーブル名を取得(ExcelVBA)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub DAO_Table_Name()
'***************************************************
'DAOを使いMDBファイルのテーブル名を取得(ExcelVBA)
'***************************************************
'[Microsoft DAO 3.6 Object Library]参照設定

Dim objDtbs As DAO.Database
Dim strFilePath As String
Dim strFileName As String
Dim objTbl As TableDef
Dim strTblName As String
Dim strMsg As String

strFilePath = ThisWorkbook.Path     'ファイルのパス
strFileName = "KEN_ALL.mdb"         'ファイル名

'【エラートラップ】
On Error GoTo Table_Name:

'データベースを開く
Set objDtbs = OpenDatabase(strFilePath & "\" & strFileName)

strMsg = ""

For Each objTbl In objDtbs.TableDefs

    strTblName = objTbl.Name

        If InStr(1, Mid(strTblName, 1, 4), "MSys") = 0 Then
            strMsg = strMsg & strTblName & vbCr
            Debug.Print strTblName
        End If

Next objTbl

MsgBox strMsg, 0, "DAO_Table_Name"

Exit Sub

'【エラートラップ】
Table_Name:

MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "CreateDatabase"

End Sub

_注意事項掲載コードについて

メール会員の方々からのご投稿を改変又は実行確認をせずにそのまま掲載しているものもあります。
ご投稿者名やユーザー名は出来る限り削除させて頂いております。
十分なレム（コメント）も記述されてないものもあります。
初心者向けのコードや上級者でないと把握出来ないコードも含まれます。
実行確認がされているものには以下のコードが含まれています。
- Private Sub Test()
- Debug.Print 又は Debug.Print による結果の掲載
- 結果の画像による掲載
VBAについては互換性の問題がありますので最低「2000」を条件にしております。
VBについては「6.0」までです。
重複コードも確認されていますがご容赦下さい。
大変古い技術コードが含まれています。当初ご投稿下さった会員の方には申し訳ございませんが順次削除させて頂きます。
尚、掲示板の掲載分は当面の間、現状維持いたします。
二次掲載はご遠慮下さい。
掲載コードは動作を保証するものではありませんのでご利用の際は必ずテストを行って下さい。

変数名又は変数名の一部で良く使う単語の解釈

buffer記憶領域

temporary一時的な

letter文字

character文字列

extension拡張子

fileファイル

folderフォルダ

directoryディレクトリー

Pathパス

Array配列

※これらは略してある場合もあります(例 temporary - temp , temporary - tmp)。

DAO DAOデータベース(.mdb)作成～データ入力一連

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ExcelDAO_CreateDatabase()
'********************************************
'DAOデータベース(.mdb)作成～データ入力一連
'********************************************
'参照設定Microsoft DAO Object Libraly
'フィールド名をコードで設定する場合

Dim strFilePath As String
Dim strFileName As String
Dim strTblName As String
Dim strTblPath As String

Dim objWrkSpc As DAO.Workspace
Dim objDtbs As DAO.Database
Dim objTbl As DAO.TableDef
Dim objFld As DAO.Field
Dim objIndx As DAO.Index
Dim objRcrd As DAO.Recordset

strFilePath = ThisWorkbook.Path

strFileName = "SampleFile.mdb"  'MDBファイル名
strTblName = "SampleTbl"        'MDBファイル内テーブル名

'【エラートラップ】
On Error GoTo DAO_CreateDatabase:
'【総合パスの作成】
strTblPath = strFilePath & "\" & strFileName
'【ワークスペース】
Set objWrkSpc = DBEngine.Workspaces(0)
'【データベース作成】(dbLangGeneral/dbLangJapanese)
Set objDtbs = objWrkSpc.CreateDatabase(strTblPath, dbLangJapanese)
'【テーブル作成】
Set objTbl = objDtbs.CreateTableDef(strTblName)

'---------------------------------------------------------
'【フィールド作成】(フィールド名・データ型・サイズ)
Set objFld = objTbl.CreateField("INDEX", dbLong)
'【オートナンバー設定】※注意1
objFld.Attributes = dbAutoIncrField
'【設定フィールド追加】
objTbl.Fields.Append objFld
'【主キー作成】
Set objIndx = objTbl.CreateIndex("PrimaryKey")
Set objFld = objIndx.CreateField("INDEX", dbLong)
'【設定フィールド追加】
objIndx.Fields.Append objFld
'【重複設定】(True重複なし/False重複あり)※注意2
objIndx.Primary = True
'【インデックス追加】
objTbl.Indexes.Append objIndx
'【テーブル追加】
objDtbs.TableDefs.Append objTbl

Set objIndx = Nothing
Set objFld = Nothing

'---------------------------------------------------------
Set objFld = objTbl.CreateField("NUMBER", dbLong, 6)
objTbl.Fields.Append objFld
'---------------------------------------------------------
Set objFld = objTbl.CreateField("NAME", dbText, 20)
objTbl.Fields.Append objFld
'---------------------------------------------------------
'更にフィールド追加は同上※注意3
'---------------------------------------------------------

Set objRcrd = objDtbs.OpenRecordset(Name:=strTblName)

'-------------------------------------------------------------------
'【新規レコード追加】
objRcrd.AddNew
'【データ入力】
Let objRcrd.Fields(0).Value = "3"           'フィールド[1]※注意1&2
Let objRcrd.Fields(1).Value = "10001"       'フィールド[2]
Let objRcrd.Fields(2).Value = "山田一郎"    'フィールド[3]
'【レコード保存】
objRcrd.Update
'-------------------------------------------------------------------
'更に追加
objRcrd.AddNew
Let objRcrd.Fields(0).Value = "13"          'フィールド[1]
Let objRcrd.Fields(1).Value = "10002"       'フィールド[2]
Let objRcrd.Fields(2).Value = "山田二郎"    'フィールド[3]
'Let objRcrd.Fields(3).Value = "やまだじろう"    'フィールド[4]※注意3
objRcrd.Update
'-------------------------------------------------------------------
'更に追加は同上
'-------------------------------------------------------------------
'※注意1
'オートナンバー設定なので値は不要でもＯＫ
'※注意2
'オートナンバー重複なし設定なので値を入力した場合、重複するとエラーになる
'※注意3
'フィールド設定が無いファールドに値を入力するとエラーになります。

'【ファイル終了】
objDtbs.Close

'【開放】
Set objFld = Nothing
Set objTbl = Nothing
Set objDtbs = Nothing
'【メッセージ】
MsgBox strFileName & vbCr & vbCr & strTblPath, 0, "完了"
'【終了】
Exit Sub

'【エラートラップ】
DAO_CreateDatabase:

    If Err = 3204 Then
        If MsgBox("同フォルダに同名ファイルが既存しています。" & vbCrLf & "[はい]上書き/[いいえ]終了", vbYesNo, "") = vbYes Then
            Kill strTblPath
            Resume
        Else
            Exit Sub
        End If
    Else
        MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "CreateDatabase"
    End If

End Sub

Dictionary 配列の同じ要素を削除するDictionary(Bound)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub DicArraySameElementDelBou(ByVal DB As Variant, ByRef DB2() As String)
'*****************************************************
'FSO 配列の同じ要素を削除するDictionary(Bound)
'*****************************************************

'Dictionaryオブジェクト
Dim obj As Object, i As Long, n As Long

  Set obj = CreateObject("Scripting.Dictionary")

  n = 0
  For i = LBound(DB) To UBound(DB)
      If obj.Exists(DB(i)) = False Then
        obj.Add DB(i), ""
        ReDim Preserve DB2(n) As String
        DB2(n) = DB(i)
        n = n + 1
      End If
  Next i

  Set obj = Nothing

End Sub

Private Sub test()
Dim i As Long, x(5) As String, DB2() As String
'テストデータ
x(0) = "1"
x(1) = "A"
x(2) = "1"
x(3) = "B"
x(4) = ""
x(5) = "1"

Call DicArraySameElementDelBou(x, DB2())

'値を表示
    For i = LBound(DB2) To UBound(DB2)
        Debug.Print i & vbTab & DB2(i)
    Next i

'0   1
'1   A
'2   B
'3
End Sub

DAO 条件に一致するレコードを取得(Findメソッド)エクセル連携サンプル

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Dictionary 配列の同じ要素を削除するDictionary(Each)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub DAO_Find_Record_Sample()
'***********************************************
'DAO 条件に一致するレコードを取得(Findメソッド)
'***********************************************
'[Microsoft DAO 3.6 Object Library]参照設定
'エクセル連携サンプル(122,852個からのデータ検索)
Dim objDtbs As DAO.Database
Dim objRcrd As DAO.Recordset
Dim strTblName As String
Dim strFilePath As String
Dim strFileName As String
Dim strFindFieldName As String
Dim strMatchFieldName(4) As String
Dim strSeek As String
Dim strSQL As String
Dim strMSG As String, h As Long

strFilePath = ThisWorkbook.Path             'ファイルのパス
strFileName = "KEN_ALL.mdb"                 'ファイル名
strTblName = "KEN_ALL"                      'テーブル名
strFindFieldName = "フィールド3"            '検索フィールド名
strMatchFieldName(1) = "フィールド3"        '検索結果フィールド名
strMatchFieldName(2) = "フィールド7"        '検索結果フィールド名
strMatchFieldName(3) = "フィールド8"        '検索結果フィールド名
strMatchFieldName(4) = "フィールド9"        '検索結果フィールド名
strSeek = "0600008"                         '検索文字

Dim sht As Worksheet

Set sht = ThisWorkbook.Worksheets("Sheet2")

'【エラートラップ】
On Error GoTo ThisERR:

'【データベースを開く】
Set objDtbs = OpenDatabase(strFilePath & "\" & strFileName)
'【指定テーブルのレコード取得】
Set objRcrd = objDtbs.OpenRecordset(strTblName)

For h = 2 To sht.Cells(65536, 6).End(xlUp).Row

        strSeek = sht.Cells(h, 6).Value
        strSeek = Trim(strSeek)
        If strSeek = "" Then GoTo endLoop:
        If Len(strSeek) = 8 Then
            strSeek = Mid(strSeek, 1, 3) & Mid(strSeek, 5)
        Else
            GoTo endLoop:
        End If

objRcrd.FindFirst strFindFieldName & "=" & "'" & strSeek & "'"

If objRcrd.NoMatch = False Then
    sht.Cells(h, 9).Value = objRcrd.Fields(strMatchFieldName(2))
    sht.Cells(h, 10).Value = objRcrd.Fields(strMatchFieldName(3))
    sht.Cells(h, 11).Value = objRcrd.Fields(strMatchFieldName(4))
Else
'    MsgBox "見つかりません", 0, strSeek
End If

endLoop:
Next h
'--------------------------------------------------------------
'メソッド       | 開始位置  | 検索方向  | 用途
'---------------|-----------|-----------|-----------------
'FindFirst      | 先頭      | 終端      | カレント
'FindLast       | 終端      | 先頭      | カレント
'FindNext       | カレント  | 終端      | 複数存在
'FindPrevious   | カレント  | 先頭      | 複数存在
'---------------|-----------|-----------|-----------------
'プロパティ     | 検索成功  | 検索失敗  |
'---------------|-----------|-----------|-----------------
'NoMatch        | False     | True      |
'---------------|-----------|-----------|-----------------
'演算子         | =,<,>,<=,>=
'--------------------------------------------------------------

'【レコードを閉じる】
objRcrd.Close
'【データベースを閉じる】
objDtbs.Close
' 【オブジェクト解放】
Set objRcrd = Nothing
Set objDtbs = Nothing

MsgBox "END!", 0, "FIND"

Exit Sub
'【エラートラップ】
ThisERR:

MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "ErrNumber:" & Err.Number

End Sub

Option Explicit

Sub DicArraySameElementDelEach(ByVal DB As Variant, ByRef DB2() As String)
'*****************************************************
'FSO 配列の同じ要素を削除するDictionary(Each)
'*****************************************************

'Dictionaryオブジェクト
Dim obj As Object, vrn As Variant, n As Long

    Set obj = CreateObject("Scripting.Dictionary")

    n = 0
    For Each vrn In DB
        If obj.Exists(vrn) = False Then
            obj.Add vrn, ""
            ReDim Preserve DB2(n) As String
            DB2(n) = vrn
            n = n + 1
        End If
    Next vrn

    Set obj = Nothing

End Sub

Private Sub test()
Dim i As Long, x(5) As String, DB2() As String
'テストデータ
x(0) = "1"
x(1) = "A"
x(2) = "1"
x(3) = "B"
x(4) = ""
x(5) = "1"

Call DicArraySameElementDelEach(x, DB2())

'値を表示
    For i = LBound(DB2) To UBound(DB2)
        Debug.Print i & vbTab & DB2(i)
    Next i

'0   1
'1   A
'2   B
'3
End Sub

DAO DAOを使用しMDBデータをシートにインポート

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub DAOを使用しMDBデータをシートにインポート()
'*****************************************
'DAOを使用しMDBデータをシートにインポート
'*****************************************
'VBEメニュー
'「ツール」→「参照設定」→ "Microsoft DAO 3.6 Object Library"チェック
    Dim MYSHT As Worksheet
    Dim MDBオブジェクト As Database
    Dim テーブル名 As String
    Dim MDB名 As String
    Dim レコード As Recordset
    Dim レコード数 As Integer
    Dim エスキューエル As String

    'データベースファイルフォルダーパス
    ChDir "C:\My Documents\データベースフォルダ"
    '「ファイルを開く｣ダイアログ表示("データベースファイル(*.mdb))
    MDB名 = Application.GetOpenFilename("データベースファイル(*.mdb),*.mdb")
    '上記で[キャンセル]が押されたらプロシージャを終了
    If MDB名 = "False" Then Exit Sub
    '変数に指定シートＳＥＴ
    Set MYSHT = ThisWorkbook.Worksheets("Sheet1")
    'シート全体をクリア
    MYSHT.Cells.Clear

    Set MDBオブジェクト = OpenDatabase(MDB名)

    エスキューエル = "SELECT * FROM " & "Sheet1" & ";"

    Set レコード = MDBオブジェクト.OpenRecordset(エスキューエル)

    With MYSHT
       For レコード数 = 1 To レコード.Fields.Count
           .Cells(1, レコード数).Value = レコード.Fields(レコード数 - 1).Name
       Next レコード数
       .Range("A2").CopyFromRecordset レコード
    End With

    レコード.Close
    MDBオブジェクト.Close

    Set レコード = Nothing
    Set MDBオブジェクト = Nothing
    Set MYSHT = Nothing

End Sub

DAO DAOを使いMDBファイルを開けてデータを読む(ExcelVBA)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub DAO_MDB_OpenRead()
'***************************************************
'DAOを使いMDBファイルを開けてデータを読む(ExcelVBA)
'***************************************************
'[Microsoft DAO 3.6 Object Library]参照設定

Dim objDtbs As DAO.Database
Dim objRcrd As DAO.Recordset
Dim strFilePath As String
Dim strFileName As String
Dim strTblName As String
Dim strFieldName() As String
Dim lngFldCnt As Long
Dim lngMvRcrd As Long
Dim strMv As String
Dim i As Long

strFilePath = ThisWorkbook.Path     'ファイルのパス
strFileName = "KEN_ALL.mdb"         'ファイル名
strTblName = "KEN_ALL"              'テーブル名

'【エラートラップ】
On Error GoTo MDB_OpenRead:

'【データベースを開く】
Set objDtbs = OpenDatabase(strFilePath & "\" & strFileName)
'【テーブルを開く】
Set objRcrd = objDtbs.OpenRecordset(strTblName)

With objRcrd
'【フィールド数カウント】
    For i = 1 To .Fields.Count
        lngFldCnt = lngFldCnt + 1
        ReDim Preserve strFieldName(lngFldCnt) As String
'【フィールド名取得】
        strFieldName(lngFldCnt) = .Fields(i - 1).Name
    Next
End With

'【先頭のレコードに移動】
objRcrd.MoveFirst

Do Until objRcrd.EOF

    lngMvRcrd = lngMvRcrd + 1

    strMv = ""
'【レコードの値を取得】
        For i = 1 To lngFldCnt
            strMv = strMv & i & vbTab & strFieldName(i) & vbTab & vbTab & objRcrd(strFieldName(i)).Value & vbCr
        Next i

    If MsgBox(strMv, vbOKCancel, "レコード" & lngMvRcrd) = vbCancel Then
        GoTo OpenRead_END:
    End If
'【次のレコードに移動】
    objRcrd.MoveNext
Loop

OpenRead_END:

'【データベースを閉じる】
objDtbs.Close

Set objRcrd = Nothing
Set objDtbs = Nothing

Exit Sub

'【エラートラップ】
MDB_OpenRead:

MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "CreateDatabase"

End Sub

DAO DAO参照設定エクセル(ExcelVBA)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub DAOAddFromFile()
'****************************************
'DAO参照設定エクセル(ExcelVBA)
'****************************************
'DAOとADOを両方参照設定しているとその後のコードに影響があります。
'※↑問題はありませんが変数宣言が面倒になります。

Dim objBok As Workbook
Dim objName As String

Set objBok = ThisWorkbook

'DAO Version3.6(Access2000)
objName = "C:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll"

If Dir(objName) = "" Then
'DAO Version3.5(Access97)
objName = "C:\Program Files\Common Files\Microsoft Shared\DAO\dao350.dll"
    If Dir(objName) = "" Then
        MsgBox "DAO DLLが見つかりません！", vbCritical, "DAO参照設定Error!"
        Exit Sub
    End If
End If

On Error GoTo ONERR:

objBok.VBProject.References.AddFromFile (objName)

Exit Sub

ONERR:

'参照設定済み以外のエラー
If Err.Number <> 32813 Then
    MsgBox Err.Number & vbTab & Err.Description, vbCritical, "DAO参照設定Error!"
End If

End Sub

DAO 条件に一致するレコードを取得(Findメソッド)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub DAO_Find_Record()
'***********************************************
'DAO 条件に一致するレコードを取得(Findメソッド)
'***********************************************
'[Microsoft DAO 3.6 Object Library]参照設定

Dim objDtbs As DAO.Database
Dim objRcrd As DAO.Recordset
Dim strTblName As String
Dim strFilePath As String
Dim strFileName As String
Dim strFindFieldName As String
Dim strMatchFieldName(4) As String
Dim strSeek As String
Dim strSQL As String
Dim strMSG As String

strFilePath = ThisWorkbook.Path             'ファイルのパス
strFileName = "KEN_ALL.mdb"                 'ファイル名
strTblName = "KEN_ALL"                      'テーブル名
strFindFieldName = "フィールド3"            '検索フィールド名
strMatchFieldName(1) = "フィールド3"        '検索結果フィールド名
strMatchFieldName(2) = "フィールド7"        '検索結果フィールド名
strMatchFieldName(3) = "フィールド8"        '検索結果フィールド名
strMatchFieldName(4) = "フィールド9"        '検索結果フィールド名
strSeek = "0600008"                         '検索文字

'【エラートラップ】
On Error GoTo ThisERR:

'【データベースを開く】
Set objDtbs = OpenDatabase(strFilePath & "\" & strFileName)
'【指定テーブルのレコード取得】
Set objRcrd = objDtbs.OpenRecordset(strTblName)

objRcrd.FindFirst strFindFieldName & "=" & "'" & strSeek & "'"

If objRcrd.NoMatch = False Then
    strMSG = objRcrd.Fields(strMatchFieldName(1)) & vbCr
    strMSG = strMSG & objRcrd.Fields(strMatchFieldName(2)) & vbCr
    strMSG = strMSG & objRcrd.Fields(strMatchFieldName(3)) & vbCr
    strMSG = strMSG & objRcrd.Fields(strMatchFieldName(4))
    MsgBox strMSG, 0, strSeek
Else
    MsgBox "見つかりません", 0, strSeek
End If

'--------------------------------------------------------------
'メソッド       | 開始位置  | 検索方向  | 用途
'---------------|-----------|-----------|-----------------
'FindFirst      | 先頭      | 終端      | カレント
'FindLast       | 終端      | 先頭      | カレント
'FindNext       | カレント  | 終端      | 複数存在
'FindPrevious   | カレント  | 先頭      | 複数存在
'---------------|-----------|-----------|-----------------
'プロパティ     | 検索成功  | 検索失敗  |
'---------------|-----------|-----------|-----------------
'NoMatch        | False     | True      |
'---------------|-----------|-----------|-----------------
'演算子         | =,<,>,<=,>=
'--------------------------------------------------------------

'【レコードを閉じる】
objRcrd.Close
'【データベースを閉じる】
objDtbs.Close
' 【オブジェクト解放】
Set objRcrd = Nothing
Set objDtbs = Nothing

Exit Sub
'【エラートラップ】
ThisERR:

MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "ErrNumber:" & Err.Number

End Sub

FSO Attributesプロパティ定数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Attributes プロパティ

ファイルまたはフォルダの属性を設定します。値の取得も可能です。属性によっては、値の取得のみ可能な場合もあります。

object.Attributes [= newattributes]
引数
object
必ず指定します。File オブジェクトまたは Folder オブジェクトの名前を指定します。
newattributes
省略可能です。object に指定したファイルまたはフォルダに与える新しい属性値を指定します。
設定値
newattributes には、次に示す値を指定できます。また、複数の定数を組み合わせて、値の和を指定することもできます。

定数	値	内容
Normal	0	標準ファイル。どの属性も設定されません。
ReadOnly	1	読み取り専用ファイル。この属性は、値の取得も設定も可能です。
Hidden	2	隠しファイル。この属性は、値の取得も設定も可能です。
System	4	システムファイル。この属性は、値の取得も設定も可能です。
Volume	8	ディスクドライブボリュームラベル。この属性は、値の取得のみ可能です。
Directory	16	フォルダまたはディレクトリ。この属性は、値の取得のみ可能です。
Archive	32	ファイルが前回のバックアップ以降に変更されているかどうか。この属性は、値の取得も設定も可能です。
Alias	64	リンクまたはショートカット。この属性は、値の取得のみ可能です。
Compressed	128	圧縮ファイル。この属性は、値の取得のみ可能です。

対象

File オブジェクト | Folder オブジェクト

Dictionary Dictionaryオブジェクト基本サンプルコード(全プロパティ・メソッド)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

説明

Dictionaryつまり辞書です。
項目インデックスや参考本などの末頁にある索引です。
ＩＭＥの単語登録と同じ機能をします。
キー(左)と項目(右)で登録します。
キーはデータベースの概念のキーに似ていますが文字でも構いません。
登録の仕方によっては単一の検索やグループの検索が簡単に出来ます。
フィルター機能に似ています。
「私の辞書に”不可能”は無い」、本当に”不可能”の文字があるか無いか捜せます。

Option Explicit

Private Sub testDictionary()
'*******************************
'Dictionary オブジェクト作成方法
'*******************************

Dim d
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "アテネ" ' キーと項目を追加します。
d.Add "b", "ベオグラード"
d.Add "c", "カイロ"

End Sub

Private Sub TestCount()
'*******************************
'Count プロパティ
'*******************************

'コレクションの中のオブジェクト数を返す。値の取得のみ可能。
'Dictionary オブジェクトに格納される項目の数を返す。値の取得のみ可能。

'Object.Count
'object には、[対象] 一覧内のいずれかの項目の名前を指定します。

Dim a, d, i, s   ' 変数を作成します。
Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "アテネ"   ' キーと項目を追加します。
    d.Add "b", "ベオグラード"
    d.Add "c", "カイロ"
    a = d.Keys   ' キーを取得します。
        For i = 0 To d.Count - 1 ' 配列に繰り返し処理を行います。
           Debug.Print a(i)  ' 結果を返します。
        Next
'a
'B
'c
End Sub

Private Sub testItem()
'*******************************
'item プロパティ
'*******************************

'Dictionary オブジェクトにある指定されたキーと関連付ける項目を設定します｡
'コレクションの場合は､指定されたキーに対応するオブジェクトを返します｡
'値の取得も可能です｡

'object.Item(key)[ = newitem]
'引数
'Object
'必ず指定コレクションまたは Dictionary オブジェクトの名前を指定します。
'key
'必ず指定取得または設定する項目に関連付けられているキーを指定します｡
'newitem
'省略可能 Dictionary オブジェクトの場合のみ指定可能で、コレクションには使用できません。
'         引数 key で指定したキーに関連付ける新しい値を指定します。

'解説
'項目を変更するときに引数 key で指定したキーが見つからない場合、
'newitem で指定した項目と関連付けられた、引数 key で指定した新
'しいキーが作成されます。また、既存の項目を取得するときに引数
'key で指定したキーが見つからない場合は、空の項目と関連付けられ
'た、引数 key で指定した新しいキーが作成されます。

Dim d
Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "アテネ"   ' キーと項目を追加します。
    d.Add "b", "ベオグラード"
    d.Add "c", "カイロ"
    Debug.Print d.item("c")   ' 項目を取得します。
'カイロ
End Sub

Private Sub testkey()
'*******************************
'key プロパティ
'*******************************

'Dictionary オブジェクトにキーを設定します｡

'Object.key(key) = newkey
'引数
'Object
'必ず指定 Dictionary オブジェクトの名前を指定します｡
'key
'必ず指定変更するキーの値を指定します｡
'newkey
'必ず指定引数 key で指定したキーと置き換える新しいキーを指定します。

'解説
'キーを変更するときに引数 key で指定したキーが見つからなかった場合は、
'引数 key の指定を使って、空の項目を持つ新しいキーが作成されます。

Dim d   ' 変数を作成します。
Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "アテネ"   ' キーと項目を追加します。
    d.Add "b", "ベオグラード"
    d.Add "c", "カイロ"
    d.key("c") = "d"   ' "c" のキーを "d" にセットします。
    Debug.Print d.item("d")   ' 関連した項目を返します。
'カイロ
End Sub

Private Sub testAdd()
'*******************************
'Add メソッド
'*******************************

'Dictionary オブジェクトに 1 組のキーと項目を追加します。

'object.Add (key, item)
'引数
'Object
'必ず指定 Dictionary オブジェクトの名前を指定します｡
'key
'必ず指定引数 item で指定した項目と関連付けるキーを指定します。
'item
'必ず指定引数 key で指定したキーと関連付ける項目を指定します。

'解説
'引数 key で指定したキーが既に存在していた場合は、エラーが発生します。

Dim d
Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "アテネ"   ' キーと項目を追加します。
    d.Add "b", "ベオグラード"
    d.Add "c", "カイロ"

End Sub

Private Sub testExists()
'*******************************
'Exists メソッド
'*******************************

'指定したキーが Dictionary オブジェクト内に
'存在する場合は、真 (true) を返す。
'存在しない場合は、偽 (false) を返す。

'Object.Exists (key)
'引数
'Object
'必ず指定 Dictionary オブジェクトの名前を指定します｡
'key
'必ず指定 Dictionary オブジェクト内で検索するキーの値を指定します｡

Dim d, msg   ' 変数を作成します。
Set d = CreateObject("Scripting.Dictionary")
   d.Add "a", "アテネ"   ' キーと項目を追加します。
   d.Add "b", "ベオグラード"
   d.Add "c", "カイロ"
    If d.Exists("c") Then
       msg = "指定したキーは存在します。"
    Else
       msg = "指定したキーはありません。"
    End If
    Debug.Print msg
'指定したキーは存在します。
End Sub

Private Sub testItems()
'*******************************
'Items メソッド
'*******************************

'Dictionary オブジェクト内のすべての項目を格納した配列を返します｡

'object.Items( )
'object には、Dictionary オブジェクトの名前を指定します。

Dim a, d, i, s   ' 変数を作成します。
Set d = CreateObject("Scripting.Dictionary")
   d.Add "a", "アテネ"   ' キーと項目を追加します。
   d.Add "b", "ベオグラード"
   d.Add "c", "カイロ"
   a = d.Items   ' 項目を取得します。
    For i = 0 To d.Count - 1 ' 取得した配列に繰り返し処理を行います。
       Debug.Print a(i) ' 結果を返します。
    Next
'アテネ
'ベオグラード
'カイロ
End Sub

Private Sub testKeys()
'*******************************
'Keys メソッド
'*******************************

'Dictionary オブジェクト内のすべての既存キーを格納した配列を返します｡

'object.Keys( )
'object には、Dictionary オブジェクトの名前を指定します。

Dim a, d, i   ' 変数を作成します。
Set d = CreateObject("Scripting.Dictionary")
   d.Add "a", "アテネ"   ' キーと項目を追加します。
   d.Add "b", "ベオグラード"
   d.Add "c", "カイロ"
   a = d.Keys   ' キーを取得します。
    For i = 0 To d.Count - 1 ' 取得した配列に繰り返し処理を行います。
       Debug.Print a(i)  ' 結果を返します。
    Next
'a
'B
'c
End Sub

Private Sub testRemove()
'*******************************
'Remove メソッド
'*******************************

'Dictionary オブジェクトからキーと項目の組みを削除します｡

'Object.Remove (key)
'引数
'Object
'必ず指定 Dictionary オブジェクトの名前を指定します｡
'key
'必ず指定 Dictionary オブジェクトから削除するキーと項目の組みと
'                    関連付けられた引数 key を指定します。
'解説
'存在しないキーを指定した場合は､エラーが発生します｡

Dim a, d, i  ' 変数を作成します。
Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "アテネ"   ' キーと項目を追加します。
    d.Add "b", "ベオグラード"
    d.Add "c", "カイロ"

    d.Remove ("b")  '  2 つ目の組を削除します。

    a = d.Items   ' 項目を取得します。
    For i = 0 To d.Count - 1 ' 配列に繰り返し処理を行います。
       Debug.Print a(i)  ' 結果を返します。
    Next
'アテネ
'カイロ
End Sub

Private Sub testRemoveAll()
'*******************************
'RemoveAll メソッド
'*******************************

'Dictionary オブジェクトからすべてのキーと項目を削除します｡

'object.RemoveAll( )
'object には、Dictionary オブジェクトの名前を指定します。

Dim a, d, i   ' 変数を作成します。
Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", "アテネ"   ' キーと項目を追加します。
    d.Add "b", "ベオグラード"
    d.Add "c", "カイロ"

    a = d.RemoveAll   ' // 辞書をクリアします。

    Debug.Print d.Count   ' 結果を返します。
' 0
End Sub

Dictionary Dictionaryオブジェクト一覧(Scriptingランタイム)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Scripting ランタイム Dictionary オブジェクトキーと項目を対で格納するオブジェクト FileSystemObject(FSO)と同じ機能を持ちます。
プロパティ	動作
Count	コレクション内または Dictionary オブジェクト内にある項目の数を返します。
Item	Dictionary オブジェクト内において指定したキーに対応する項目を設定または参照します。コレクションの場合は、指定したに基づくを返します。
Key	Dictionary オブジェクト内でキーを設定します。
メソッド	動作
Add(Dictionary)	キーと項目のペアを Dictionary オブジェクトに追加します。
Exists	指定したキーが Dictionary オブジェクト内に存在すれば true を返し、存在しなければ false を返します。
Items	Dictionary オブジェクト内のすべての項目を格納した配列を返します。
Keys	Dictionary オブジェクト内のすべての既存のキーを格納した配列を返します。
Remove	キーと項目の 1 組のペアを Dictionary オブジェクトから削除します。
RemoveAll	すべてのキーと項目のペアを Dictionary オブジェクトから削除します。

FSO FileSystemObject(FSO)プロパティ・メソッド一覧Drives-Folders-Files

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

オブジェクトとコレクション一覧

Drive オブジェクト
- 特定のディスクドライブまたはネットワーク共有のプロパティにアクセスできます。
Folder オブジェクト
- フォルダのすべてのプロパティにアクセスできます。
File オブジェクト
- ファイルのすべてのプロパティにアクセスできます。
FileSystemObject オブジェクト
- コンピュータのファイルシステムにアクセスできます。
TextStream オブジェクト
- ファイルへのシーケンシャルアクセスを容易にします。
Dictionary オブジェクト
- データキーと項目のペアを格納するオブジェクトです。
Drives コレクション
- 利用可能なすべてのドライバの読み取り専用コレクションです。
Folders コレクション
- Folder オブジェクト内に含まれているすべての Folder オブジェクトのコレクションです。
Files コレクション
- フォルダ内にあるすべての File オブジェクトのコレクションです。

Drives コレクション
プロパティ	動作
Count	コレクション内または Dictionary オブジェクト内にある項目の数を返します。
Item	Dictionary オブジェクト内において指定したキーに対応する項目を設定または参照します。コレクションの場合は、指定したに基づくを返します。
メソッド	動作
なし	なし

Folders コレクション
プロパティ	動作
Count	コレクション内または Dictionary オブジェクト内にある項目の数を返します。
Item	Dictionary オブジェクト内において指定したキーに対応する項目を設定または参照します。コレクションの場合は、指定したに基づくを返します。
メソッド	動作
Add(Folders)	新しいフォルダを Folders コレクションに追加します。

Files コレクション
プロパティ	動作
Count	コレクション内または Dictionary オブジェクト内にある項目の数を返します。
Item	Dictionary オブジェクト内において指定したキーに対応する項目を設定または参照します。コレクションの場合は、指定したに基づくを返します。
メソッド	動作
なし	なし

FSO FileSystemObject(FSO)プロパティ・メソッド一覧Drive-Folder-File

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

オブジェクトとコレクション一覧

Drive オブジェクト
- 特定のディスクドライブまたはネットワーク共有のプロパティにアクセスできます。
Folder オブジェクト
- フォルダのすべてのプロパティにアクセスできます。
File オブジェクト
- ファイルのすべてのプロパティにアクセスできます。
FileSystemObject オブジェクト
- コンピュータのファイルシステムにアクセスできます。
TextStream オブジェクト
- ファイルへのシーケンシャルアクセスを容易にします。
Dictionary オブジェクト
- データキーと項目のペアを格納するオブジェクトです。
Drives コレクション
- 利用可能なすべてのドライバの読み取り専用コレクションです。
Folders コレクション
- Folder オブジェクト内に含まれているすべての Folder オブジェクトのコレクションです。
Files コレクション
- フォルダ内にあるすべての File オブジェクトのコレクションです。

Drive オブジェクト
プロパティ	動作
AvailableSpace	指定したドライブ上またはネットワーク共有上でユーザーが利用可能な領域の量を返します。
DriveLetter	物理ローカルドライブまたはネットワーク共有のドライブ名を返します。
DriveType	指定したドライブの種類を示す値を返します。
FileSystemProperty	指定したドライブで使用されているファイルシステムの種類を返します。
FreeSpace	指定したドライブ上またはネットワーク共有上でユーザーが利用可能な空き領域の量を返します。
IsReady	指定したドライブがレディ状態であれば true を返し、レディ状態でなければ false を返します。
Path	指定したファイル、フォルダ、またはドライブのパスを返します。
RootFolder	指定したドライブのルートフォルダを表す Folder オブジェクトを返します。
SerialNumber	ディスクボリュームを一意に識別するために使用する 10 進シリアル番号を返します。
ShareName	指定したドライブのネットワーク共有名を返します。
TotalSize	ドライブまたはネットワーク共有の総容量をバイト単位で返します。
VolumeName	指定したドライブのボリューム名を設定または参照します。
メソッド	動作
なし	なし

Folder オブジェクト
プロパティ	動作
Attributes	ファイルまたはフォルダの属性を設定または参照します。
DateCreated	指定したファイルまたはフォルダが作成された日付と時刻を返します。読み取り専用です。
DateLastAccessed	指定したファイルまたはフォルダが最後にアクセスされた日付と時刻を返します。
DateLastModified	指定したファイルまたはフォルダが最後に変更された日付と時刻を返します。
Drive	指定したファイルまたはフォルダのあるドライブのドライブ名を返します。
Files	指定したフォルダ内にあるすべての File オブジェクトからなる Files コレクションを返します。隠しファイル属性やシステムファイル属性が設定されたものも含まれます。
IsRootFolder	指定したフォルダがルートフォルダであれば true を返し、ルートフォルダでなければ false を返します。
Name	指定したファイルまたはフォルダの名前を設定または参照します。
ParentFolder	指定したファイルまたはフォルダの親にあたるフォルダオブジェクトを返します。
ShortName	従来の 8.3 命名規則を必要とするプログラムで使用する短い名前を返します。
ShortPath	従来の 8.3 命名規則を必要とするプログラムで使用する短いパスを返します。
Size	ファイルの場合は、指定したファイルのサイズをバイト単位で返します。フォルダの場合は、フォルダに含まれているすべてのファイルおよびサブフォルダの合計サイズをバイト単位で返します。
SubFolders	指定したフォルダ内にあるすべてのフォルダからなる Folders コレクションを返します。隠しファイル属性やシステムファイル属性が設定されたものも含まれます。
Type	ファイルまたはフォルダの種類に関する情報を返します。
Path	指定したファイル、フォルダ、またはドライブのパスを返します。
メソッド	動作
Copy	指定したファイルまたはフォルダを、ある場所から別の場所にコピーします。
CreateTextFile	指定した名前のファイルを作成し、そのファイルの読み取り、書き込みに使用できる TextStream オブジェクトを返します。
Delete	指定したファイルまたはフォルダを削除します。
Move	指定したファイルまたはフォルダを、ある場所から別の場所に移動します。

File オブジェクト
プロパティ	動作
Attributes	ファイルまたはフォルダの属性を設定または参照します。
DateCreated	指定したファイルまたはフォルダが作成された日付と時刻を返します。読み取り専用です。
DateLastAccessed	指定したファイルまたはフォルダが最後にアクセスされた日付と時刻を返します。
DateLastModified	指定したファイルまたはフォルダが最後に変更された日付と時刻を返します。
Drive	指定したファイルまたはフォルダのあるドライブのドライブ名を返します。
Name	指定したファイルまたはフォルダの名前を設定または参照します。
ParentFolder	指定したファイルまたはフォルダの親にあたるフォルダオブジェクトを返します。
ShortName	従来の 8.3 命名規則を必要とするプログラムで使用する短い名前を返します。
ShortPath	従来の 8.3 命名規則を必要とするプログラムで使用する短いパスを返します。
Size	ファイルの場合は、指定したファイルのサイズをバイト単位で返します。フォルダの場合は、フォルダに含まれているすべてのファイルおよびサブフォルダの合計サイズをバイト単位で返します。
Type	ファイルまたはフォルダの種類に関する情報を返します。
Path	指定したファイル、フォルダ、またはドライブのパスを返します。
メソッド	動作
OpenAsTextStream	指定したファイルを開き、ファイルの読み書きや追加書き込みに使用できる TextStream オブジェクトを返します。
Copy	指定したファイルまたはフォルダを、ある場所から別の場所にコピーします。
Delete	指定したファイルまたはフォルダを削除します。
Move	指定したファイルまたはフォルダを、ある場所から別の場所に移動します。

FSO FileSystemObject(FSO)プロパティ・メソッド一覧FileSystemObject-TextStream-Dictionary

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

オブジェクトとコレクション一覧

Drive オブジェクト
- 特定のディスクドライブまたはネットワーク共有のプロパティにアクセスできます。
Folder オブジェクト
- フォルダのすべてのプロパティにアクセスできます。
File オブジェクト
- ファイルのすべてのプロパティにアクセスできます。
FileSystemObject オブジェクト
- コンピュータのファイルシステムにアクセスできます。
TextStream オブジェクト
- ファイルへのシーケンシャルアクセスを容易にします。
Dictionary オブジェクト
- データキーと項目のペアを格納するオブジェクトです。
Drives コレクション
- 利用可能なすべてのドライバの読み取り専用コレクションです。
Folders コレクション
- Folder オブジェクト内に含まれているすべての Folder オブジェクトのコレクションです。
Files コレクション
- フォルダ内にあるすべての File オブジェクトのコレクションです。

FileSystemObject オブジェクト
プロパティ	動作
Drives	ローカルコンピュータ上で利用可能なすべての Drive オブジェクトからなる Drives コレクションを返します。
メソッド	動作
BuildPath	名前を既存のパスの末尾に付加します。
CopyFile	1 つまたは複数のファイルを、ある場所から別の場所にコピーします。
CopyFolder	フォルダを、ある場所から別の場所に再帰的にコピーします。
CreateFolder	フォルダを作成します。
DeleteFile	指定したファイルを削除します。
DeleteFolder	指定したフォルダとその中身を削除します。
DrivesExists	指定したドライブが存在すれば true を返し、存在しなければ false を返します。
FileExists	指定したファイルが存在すれば true を返し、存在しなければ false を返します。
FolderExists	指定したフォルダが存在すれば true を返し、存在しなければ false を返します。
GetAbsolutePathName	指定したパスから、省略されていない完全なパスを返します。
GetBaseName	パスの最後の構成要素のベース名 (ファイル拡張子を除いたもの) を表す文字列を返します。
GetDrive	指定したパスのドライブに対応する Drive オブジェクトを返します。
GetDriveName	指定したパスのドライブ名を表す文字列を返します。
GetExtensionName	パスの最後の構成要素の拡張子名を表す文字列を返します。
GetFile	指定したパスにあるファイルに対応する File オブジェクトを返します。
GetFileName	指定したパスの最後の構成要素のうちドライブ指定以外の部分を返します。
GetFileVersion	指定したファイルのバージョン番号を返します。
GetFolder	指定したパスにあるフォルダに対応する Folder オブジェクトを返します。
GetParentFolderName	指定したパスの最後の構成要素の親フォルダ名を表す文字列を返します。
GetSpecialFolder	指定した特殊フォルダのオブジェクトを返します。
GetTempName	ランダムに生成される一時ファイルまたは一時フォルダの名前を返します。これらは一時ファイルや一時フォルダを必要とする処理を実行する際に便利です。
MoveFile	1 つまたは複数のファイルを、ある場所から別の場所に移動します。
MoveFolder	1 つまたは複数のフォルダを、ある場所から別の場所に移動します。
OpenTextFile	指定したファイルを開き、ファイルの読み書きや追加書き込みに使用できる TextStream オブジェクトを返します。
CreateTextFile	指定した名前のファイルを作成し、そのファイルの読み取り、書き込みに使用できる TextStream オブジェクトを返します。

TextStream オブジェクト
プロパティ	動作
AtEndOfLine	ファイルポインタが TextStream ファイル内で行末マーカーの直前にあれば true を返し、直前になければ false を返します。
AtEndOfStream	ファイルポインタが TextStream ファイルの末尾にあれば true を返し、末尾になければ false を返します。
Column	TextStream ファイル内での現在の文字位置の列番号を返します。
Line	TextStream ファイルにおける現在の行番号を返します。
メソッド	動作
Close	開いている TextStream ファイルを閉じます。
Read	指定した数の文字を TextStream ファイルから読み取り、その結果の文字列を返します。
ReadAll	TextStream ファイル全体を読み取り、その結果の文字列を返します。
ReadLine	TextStream ファイルから 1 行 (改行文字を含まない) を読み取り、その結果の文字列を返します。
Skip	TextStream ファイルを読み取るときに、指定した文字数をスキップします。
SkipLine	TextStream ファイルを読み取るときに、次の行をスキップします。
Write	指定した文字列を TextStream ファイルに書き込みます。
WriteBlankLines	指定した数の改行文字を TextStream ファイルに書き込みます。
WriteLine	指定した文字列と改行文字を TextStream ファイルに書き込みます。

Dictionary オブジェクト
プロパティ	動作
CompareMode	Dictionary オブジェクト内の文字列キーを比較する際の比較モードを設定または参照します。
Count	コレクション内または Dictionary オブジェクト内にある項目の数を返します。
Item	Dictionary オブジェクト内において指定したキーに対応する項目を設定または参照します。コレクションの場合は、指定したに基づくを返します。
Key	Dictionary オブジェクト内でキーを設定します。
メソッド	動作
Add(Dictionary)	キーと項目のペアを Dictionary オブジェクトに追加します。
Exists	指定したキーが Dictionary オブジェクト内に存在すれば true を返し、存在しなければ false を返します。
Items	Dictionary オブジェクト内のすべての項目を格納した配列を返します。
Keys	Dictionary オブジェクト内のすべての既存のキーを格納した配列を返します。
Remove	キーと項目の 1 組のペアを Dictionary オブジェクトから削除します。
RemoveAll	すべてのキーと項目のペアを Dictionary オブジェクトから削除します。

ファイル FreeFile関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

FreeFile 関数

使用可能なファイル番号を整数型 (Integer) の値で返すファイル入出力関数です。

構文
FreeFile[(rangenumber)]
引数

rangenumber
には、ファイル番号の範囲をバリアント型 (Variant) で指定します。指定した範囲から次に使用可能なファイル番号を返します。この引数は省略可能です。
0 (既定値)1 ～ 255 の範囲のファイル番号が返されます。
1256 ～ 511 の範囲のファイル番号が返されます。
解説
使用可能なファイル番号を取得するために FreeFile 関数を使用します。既に使われているファイル番号を重複して使うのを防ぐことができます。

FreeFile 関数の使用例

Open ステートメント

ファイル FileSearchオブジェクト

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

FileSearch オブジェクト

[ファイルを開く] ダイアログボックス ([ファイル] メニュー) の機能を表します。

使い方

FileSearch オブジェクトを取得するには、FileSearch プロパティを使用します。次の使用例は、指定されたファイルを検索し、見つかったファイルの総数と、各ファイルのファイル名を表示します。

Option Explicit

With Application.FileSearch
    If .Execute() > 0 Then
        MsgBox .FoundFiles.Count & _
            " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

検索条件を既定の設定にリセットするには、

NewSearch メソッド

を使用します。すべてのプロパティの値は、検索を実行した後も保持されます。NewSearch メソッドを使用すると、別の条件でファイルを検索するときに、前のプロパティの値を 1 つずつ削除または変更しなくても、新しいプロパティの値をすぐに設定できます。次の使用例は、検索条件を既定の設定にリセットした後、新しい検索を開始します。

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .Filename = "Run"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
End With

ファイル FoundFilesプロパティの使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'
'次の使用例は､ファイル検索で見つかったファイルの一覧をチェックし､各ファイルのパスを表示します｡

With Application.FileSearch
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
End With

ファイル Executeメソッド(FileSearchオブジェクト)の使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Execute メソッド (FileSearch オブジェクト)

FileSearch オブジェクトでは、指定したファイルの検索を開始します。

構文
expression.Execute(SortBy, SortOrder, AlwaysAccurate)
expression
必ず指定します。FileSearch オブジェクトを表すオブジェクト式を指定します。
SortBy
省略可能です。バリアント型 (Variant) の値を指定します。検索結果のファイルを並べ替えるときの基準を指定します。使用できる定数は、MsoSortBy クラスの msoSortbyFileName (ファイル名)、 msoSortbyFileType (ファイルの種類)、 msoSortbyLastModified (更新日時)、 msoSortbySize (サイズ) のいずれかです。
SortOrder
省略可能です。バリアント型 (Variant) の値を指定します。検索結果のファイル一覧を並べ替えるときの順序を指定します。使用できる定数は、MsoSortOrder クラスの msoSortOrderAscending (昇順) または msoSortOrderDescending (降順) です。
AlwaysAccurate
省略可能です。ブール型 (Boolean) の値を指定します。True を指定すると、ファイル一覧が最後に更新されてから追加、変更、または削除されたファイルも検索の対象に含まれます。既定値は True です。

Execute メソッド (FileSearch オブジェクト) の使用例

次の使用例は、[My Documents] フォルダの中で、ファイル名の拡張子が ".doc" のファイルをすべて検索し、条件を満たすファイルの名前と保存場所の一覧を表示します。また、検索結果のファイル一覧を、ファイル名の昇順で並べ替えます。

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .Filename = "*.doc"
    If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox .FoundFiles.Count & _
            " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

バックアップ自らを指定フォルダ内へバックアップ

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub Backup()
'************************************
'自らを指定フォルダ内へバックアップ
'************************************
'使用サブルーチン及びファンクション
'--- BkOrBackUp     (バックアップエンジン)
'--- BKUFolder      (フォルダ作成)
'--- DateTimeName   (ファイル名作成)

Dim str(4) As String, BkFaolName As String

BkFaolName = "バックアップ" 'バックアップを作るフォルダ名

str(1) = "現在の変更や入力後のバックアップを開始します。"
str(2) = "※環境によってはやや時間を要します。"
str(3) = "バックアップをキャンセルしました。"

If MsgBox(str(1) & vbCr & vbCr & str(2), vbOKCancel, FileName) = vbCancel Then
    'Cancelした場合
    MsgBox str(3), vbInformation, FileName
    Exit Sub
End If

str(4) = BkOrBackUp(BkFaolName)

If str(4) = "" Then
   MsgBox "バックアップを完了出来ませんでした。", vbCritical, FileName
Else
   MsgBox "バックアップを完了しました。" & vbCr & vbCr & _
   "完了場所" & vbCr & str(4), vbInformation, FileName
End If

End Sub

Function BkOrBackUp(strFolname As String) As String
'********************************
'ファイルのコピー(バックアップ)
'********************************
'コピー(バックアップ)したパス～ファイル名を返す
'エクセルブック限定

Dim TruePath As String, FalsePath As String
Dim FalseName As String, NewPath As String

BKUFolder strFolname

On Error GoTo TheERR:

'===================================================================
'バックアップの仕組みと解説
'===================================================================
'[真ファイル]_[真パス]+[真ファイル名]取得 [A]①
TruePath = ThisWorkbook.Path & "\" & ThisWorkbook.Name

'[偽ファイル名]_作成(DateTimeName=ファイル名 FileExtensionName=拡張子) [A]①
FalseName = DateTimeName & FileExtensionName(ThisWorkbook.Name)

'[偽パス]+[偽ファイル名]_作成 [A]①
FalsePath = ThisWorkbook.Path & "\" & FalseName

'[真ファイル]を[偽パス]+[偽ファイル名]で保存 [B]②
ThisWorkbook.SaveAs FalsePath

'[新パス]+[新ファイル名]_作成 [B]②
NewPath = ThisWorkbook.Path & "\" & strFolname & "\" & DateTimeName & FileExtensionName(ThisWorkbook.Name)

'[真ファイル]を[新パス]+[新ファイル名]へ移動及び[新ファイル名]に変更 [B]③
Name TruePath As NewPath

'[真ファイル]_[真パス]+[真ファイル名]で保存 [C]④
ThisWorkbook.SaveAs TruePath

'[偽ファイル]削除 [C]⑤
Kill (FalsePath)

BkOrBackUp = NewPath

Exit Function

TheERR:

MsgBox "ファイルのコピー(バックアップ)エラー！", vbCritical, FileName
BkOrBackUp = ""

End Function

Sub BKUFolder(folName As String)
'**************************************
'目的のフォルダを検索、無い場合作成する
'**************************************
'バックアップ用

Dim strFl_mn As String
Dim dirFile As String

'パラメータ
'フォルダ名(パスも含む)
strFl_mn = ThisWorkbook.Path & "\" & folName

'無い場合目的フォルダを作成
If Dir$(strFl_mn, vbDirectory) = "" Then
MkDir strFl_mn
End If

End Sub

Function DateTimeName() As String
'*********************************
'現在の日付と時刻から文字列作成
'*********************************
'ファイル名やフォルダ名に使用する場合など
'１４文字(yyyymmddhhnnss)で返します。
'年年年年月月日日時時分分秒秒

Dim str As String
str = Now
DateTimeName = Format(str, "yyyy") & Format(str, "mm") & Format(str, "dd") _
& Format(str, "hh") & Format(str, "nn") & Format(str, "ss")
End Function

'Private Sub testDateTimeName()
' MsgBox DateTimeName
'End Sub

ファイル Filenameプロパティの使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

次の使用例は、[My Documents] フォルダに保存されている "cmd" で始まり、拡張子が付いているすべてのファイルを検索し、名前と保存場所を表示します。

Option Explicit

'
Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .Filename = "cmd*.*"
    If .Execute > 0 Then
        MsgBox .FoundFiles.Count & " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "ファイルは見つかりませんでした。"
    End If
End With

バックアップバックアップ（FSO）

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub FileCopy()

On Error GoTo ERROR

Dim MyPath As String
Dim TargetPath As String
Dim blnCheck As Boolean
Dim strChoice As String
Dim Mypractice As Integer
Dim FolderName As String
Dim objFSO As Object

Mytrial:
Set objFSO = CreateObject("Scripting.FileSystemObject") 'FSO定義

MyPath = Application.ActiveWorkbook.Path '現在パス
TargetPath = "\\PCname\c\My Documents\TEST\TEST" '目的のパス

blnCheck = objFSO.Folderexists(TargetPath & "1\") 'フォルダー1の存在を確認

If blnCheck = False Then '無い場合 strchoice
strChoice = MsgBox(TargetPath & " Path無いか、該当フォルダ不明です。もう一度実行しますか?" _
& vbCr & vbCr & "《はい》:この処理を中止します。" _
& vbCr & "《いいえ》:もう一度実行します。", vbYesNo, "ERROR")
Select Case strChoice
Case vbNo '《いいえ》
Set objFSO = Nothing
Exit Sub
Case vbYes '《はい》practice
Set objFSO = Nothing
GoTo Mytrial
End Select
End If

For Mypractice = 1 To 5
FolderName = TargetPath & CStr(Mypractice) & "\"
blnCheck = objFSO.Folderexists(FolderName)
If blnCheck = False Then
objFSO.copyfolder MyPath, TargetPath & CStr(Mypractice)
MsgBox "<<BackUp>>終了", 0, "END"
Set objFSO = Nothing
Exit Sub
End If
Next Mypractice

objFSO.deletefolder TargetPath & "1"
Name TargetPath & "2" As TargetPath & "1"
Name TargetPath & "3" As TargetPath & "2"
Name TargetPath & "4" As TargetPath & "3"
Name TargetPath & "5" As TargetPath & "4"

objFSO.copyfolder MyPath, TargetPath & "5"

Set objFSO = Nothing

MsgBox "<<BackUp>>終了", 0, "END"

Exit Sub

ERROR:
MsgBox "FileCopyを実行中エラー " & Err.Number & " 発生 ", vbCritical, "ERROR"

End Sub

パスワードパスワードを使用しブックを開く

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Sub psbブックを開く(myPath As String)
'*******************************************************************************
'パスワードを使用しブックを開く
'*******************************************************************************
'’画面更新無効
Application.ScreenUpdating = False
'’変数の定義
Dim TargetBook, strFileName As String
strFileName = Dir(myPath) 'ファイル名を取得

    ''error発生の場合次へ・・
    On Error Resume Next
    ''該当Ｂｏｏｋをセット
    Set TargetBook = Workbooks(strFileName)
    '’error発生の場合無効
    On Error GoTo 0
    '’既に開かれていた場合
    If IsObject(TargetBook) Then
        '’保存なしにて閉じる
        Workbooks(strFileName).Close savechanges:=False
    End If
    '’セット終了
    Set TargetBook = Nothing

    '’ターゲットブックを変更可にてオープン
    With Workbooks
        .Open Filename:=(myPath), ReadOnly:=False, Password:=fncPass
    End With

End Sub

パスワードブックにパスワードを設定し保存して閉じる

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Sub psbパスワード保存(Mybook As Workbook)
'*******************************************************************************
'ブックにパスワードを設定し保存して閉じる
'*******************************************************************************
Dim a As String, b As String, i As Long, MySheet As Worksheet
a = Mybook.Path: b = Mybook.Name
    With Mybook
        Call psbブック保護(Mybook)
            For i = 1 To Sheets.Count
                Set MySheet = Mybook.Sheets(i)
                    Call psbシート保護(MySheet)
                Set MySheet = Nothing
            Next i
        .SaveAs Filename:=a & "\" & b, WriteResPassword:=fncPass
        .Close
    End With
End Sub

バックアップバックアップ先の指定

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Sub pbsBackUpTxt()
'*******************************************************************************
'バックアップ先の指定
'*******************************************************************************
Dim a As String, b As String

b = fncTxtReadsCSV(fncBackUpRouteTxt)

If MsgBox("現在のバックアップ先は" & vbCr & vbCr & _
b & vbCr & vbCr & "変更しますか？", vbInformation + vbYesNo, "バックアップ先の確認") = vbNo Then Exit Sub

Retry:

a = fncDialogFolder("バックアップ")

If Right(a, 2) = ":\" Then
MsgBox "バックアップ先の指定に「新しいフォルダ」を作成してください。", vbCritical, "ERROR "
GoTo Retry:
End If

If a = "" Then
MsgBox "バックアップ先の指定をキャンセルしました。", vbCritical, "バックアップ先の指定"
Exit Sub
End If
pbsTxtWrites fncBackUpRouteTxt, a
MsgBox a & vbCr & vbCr & "に登録しました。", vbInformation, "バックアップ先の指定"
End Sub

バックアップバックアップサンプル

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub pbsバックアップ()
'*******************************************************************************
'バックアップ
'*******************************************************************************
Dim a As String, b As String
Dim jia As New Cls_BackUp
a = fncTxtReadsCSV(fncBackUpRouteTxt)
b = GetDriveObjectStr(a)
If b = "" Then
    MyErrMSG
    Exit Sub
End If
If DriveUmu(b) = False Then
    MyErrMSG
    Exit Sub
End If
If fncDirectoryExistence(a) = False Then
    MyErrMSG
    Exit Sub
End If
If Right(a, 1) <> "\" Then
a = a & "\"
End If
If Right(a, 2) = ":\" Then
MsgBox "バックアップ先の指定に「新しいフォルダ」を作成してください。", vbCritical, "ERROR "
Exit Sub
End If

'jia.バックアップ開始 "E:\", True
jia.バックアップ開始 a, True

End Sub

バックアップ現在開いているブックのバックアップ

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub EXCELBkup()
'
'エラー処理なし(同名保存)

Dim strNowName As String
Dim strCH As String
Dim strPath As String

'パラメータ

'*変換名
strCH = "BK"

'*保存先パス
strPath = "C:\Documents and Settings\TST\デスクトップ\XLSBK" 'パス名の例はNTの場合

strNowName = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=strPath & "\" & strCH & strNowName

'以下は簡略した方法(セル書き込みあり)
' With Range("IV1")
' .Formula = ActiveWorkbook.Name
' .Replace "xls", "bck"
' ActiveWorkbook.SaveAs .Value
' .Clear
' End With
End Sub

ダイアログアラートの表示と非表示

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

DisplayAlerts

各場面によって表示されるアプリケーションアラート
便利な事もありますが
表示させたくない場合もあります。

シート削除アラート
Application.DisplayAlerts = False
で非表示になる

ブック保存アラート
Application.DisplayAlerts = False
で非表示になる

上書きアラート
Application.DisplayAlerts = False
で非表示になる

デバックアラート
Application.DisplayAlerts = False
でも非表示にならない。

Option Explicit

'Application.DisplayAlertsのテスト
'アラートの表示と非表示

Private Sub AlertsTest1()

'DisplayAlerts 設置なし
'新ブック
'新シート
'シート削除
'シート文字挿入
'SaveChanges 　設置なし

Dim bk As Workbook, st As Worksheet
Dim pt As String, nm As String
'===================================
'Application.DisplayAlerts = False
'===================================
pt = "C:\test\"
nm = "BookTest.xls"

Set bk = Workbooks.Add
Set st = bk.Worksheets.Add
st.Delete
Set st = bk.Worksheets.Add
st.Cells(1, 1).Value = "A"
bk.Close

'bk.Close SaveChanges:=True, Filename:=pt & nm
    '      ↑
    'どちらでもＯＫ
    '      ↓
'bk.SaveAs Filename:=pt & nm
End Sub

Private Sub AlertsTest2()

'DisplayAlerts 設置なし
'既存ブック
'新シート
'シート削除
'シート文字挿入
'SaveChanges 　設置なし

Dim bk As Workbook, st As Worksheet
Dim pt As String, nm As String
'===================================
'Application.DisplayAlerts = False
'===================================
pt = "C:\test\"
nm = "BookTest.xls"

Workbooks.Open Filename:=pt & nm
Set bk = Workbooks(nm)
Set st = bk.Worksheets.Add
st.Delete
Set st = bk.Worksheets.Add
st.Cells(1, 1).Value = "A"
bk.Close

End Sub

Private Sub AlertsTest3()

'DisplayAlerts 設置なし
'既存ブック
'新シート
'シート削除
'シート文字挿入
'SaveChanges 　設置あり

Dim bk As Workbook, st As Worksheet
Dim pt As String, nm As String
'===================================
'Application.DisplayAlerts = False
'===================================
pt = "C:\test\"
nm = "BookTest.xls"

Workbooks.Open Filename:=pt & nm
Set bk = Workbooks(nm)
Set st = bk.Worksheets.Add
st.Delete
Set st = bk.Worksheets.Add
st.Cells(1, 1).Value = "A"
bk.Close SaveChanges:=True, Filename:=pt & nm

End Sub

'ブックを Visual Basic から開く場合は、Auto_Open マクロが含まれていても実行されません。
'Auto_Open マクロを実行する場合は RunAutoMacros メソッドを使ってください。

'Visual Basic を使ってブックを閉じると、ブックの Auto_Close マクロは実行されません。
'Auto_Close マクロを実行するには、RunAutoMacros メソッドを使います。

WEB ブラウザーソースを取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim a As String
With Me.WebBrowser1.Document
a = .documentelement.innerhtml '<html></html>まで
End With
MsgBox a
End Sub

WEB Htmlクラス-INDEX

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

ＷＥＢプログラミングの参考資料やサンプルコードを紹介

VBやVBAでよく使用するHtmlクラス以下メンバーのメソッド・演算子・プロパティ・イベントを紹介

HtmlDocument メンバ

WebBrowser コントロールでホストされている HTML ドキュメントに、トップレベルのプログラムによるアクセスを提供します。

HtmlDocument 型で公開されるメンバ

HtmlDocument クラス

メソッド

演算子

プロパティ

イベント

HtmlElement メンバ

Web ページ内の HTML 要素を表します。

HtmlElement 型で公開されるメンバ

HtmlElement クラス

メソッド

演算子

プロパティ

イベント

コピープロセス間通信クリップボードの関数一覧-3

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

一覧
IsClipboardFormatAvailable
- 指定されたデータ形式のデータがクリップボードに格納されているかどうかを調べます。
OpenClipboard
- 検討の目的でクリップボードを開き、他のアプリケーションがクリップボードの内容を変更できないようにします。
RegisterClipboardFormat
- クリップボードの新しいデータ形式を Windows システムに登録します。
SetClipboardData
- クリップボードに、指定されたデータ形式でデータを格納します。
SetClipboardViewer
- クリップボードビューアのチェインに、指定されたウィンドウを追加します。

一覧

関数	説明
ChangeClipboardChain	クリップボードビューアのチェインから、指定されたウィンドウを削除します。
CloseClipboard	クリップボードを閉じます。
CountClipboardFormats	現在クリップボード内に存在するデータが持つデータ形式の数を取得します。
EmptyClipboard	クリップボードを空にし、クリップボード内のデータのハンドルを解放します。
EnumClipboardFormats	現在クリップボード内に存在するデータが持つデータ形式を列挙します。
GetClipboardData	クリップボードから、指定された形式のデータを取得します。
GetClipboardFormatName	クリップボードから、指定された登録済みデータ形式の名前を取得します。
GetClipboardOwner	現在クリップボードを所有しているウィンドウのハンドルを取得します。
GetClipboardSequenceNumber	現在のウィンドウステーションのクリップボードのシーケンス番号を取得します。
GetClipboardViewer	クリップボードビューアのチェイン内にある最初のウィンドウのハンドルを取得します。
GetOpenClipboardWindow	現在クリップボードを開いているウィンドウのハンドルを取得します。
GetPriorityClipboardFormat	指定されたリストの中から、最初に利用できるクリップボードデータ形式を返します。
IsClipboardFormatAvailable	指定されたデータ形式のデータがクリップボードに格納されているかどうかを調べます。
OpenClipboard	検討の目的でクリップボードを開き、他のアプリケーションがクリップボードの内容を変更できないようにします。
RegisterClipboardFormat	クリップボードの新しいデータ形式を Windows システムに登録します。
SetClipboardData	クリップボードに、指定されたデータ形式でデータを格納します。
SetClipboardViewer	クリップボードビューアのチェインに、指定されたウィンドウを追加します。

IsClipboardFormatAvailable

指定されたデータ形式のデータがクリップボードに格納されているかどうかを調べます。

BOOL IsClipboardFormatAvailable(
UINT format // クリップボードのデータ形式
);

パラメータ
format
［入力］標準または登録済みのクリップボードデータ形式を指定します。クリップボードデータ形式の詳細については、「」（SetClipboardData 関数の説明）を参照してください。
戻り値
指定したクリップボードデータ形式のデータが格納されている場合は、0 以外の値が返ります。
指定したクリップボードデータ形式のデータが格納されていない場合は、0 が返ります。拡張エラー情報を取得するには、関数を使います。
解説
1 種類のクリップボードデータ形式しか認識しないアプリケーションが、またはメッセージを処理するときにこの関数を呼び出し、その戻り値に応じてメニューの［貼り付け］コマンドを有効または無効にするという典型的な使い方があります。複数のクリップボードフォーマットを認識するアプリケーションで同様の機能を実現する場合は、GetPriorityClipboardFormat 関数を使ってください。

OpenClipboard

検討の目的でクリップボードを開き、他のアプリケーションがクリップボードの内容を変更できないようにします。

BOOL OpenClipboard(
HWND hWndNewOwner // ウィンドウのハンドル
);

パラメータ
hWndNewOwner
［入力］クリップボードをいて関連付けたいウィンドウのハンドルを指定します。NULL を指定すると、現在のタスクがクリップボードを開きます。
戻り値
関数が成功すると、0 以外の値が返ります。
関数が失敗すると、0 が返ります。拡張エラー情報を取得するには、関数を使います。
解説
他のウィンドウが既にクリップボードを開いている場合、OpenClipboard 関数は失敗します。
OpenClipboard の呼び出しに成功するたびに、アプリケーションは CloseClipboard 関数を呼び出すべきです。
EmptyClipboard 関数を呼び出さないと、hWndNewOwner パラメータで指定したウィンドウはクリップボードのオーナーになりません。

RegisterClipboardFormat

クリップボードの新しいデータ形式を Windows システムに登録します。

登録された形式は、その直後から有効なデータ形式として使えます。

UINT RegisterClipboardFormat(
LPCTSTR lpszFormat // 新しいデータ形式の名前
);

パラメータ
lpszFormat
［入力］新しいクリップボードデータ形式の名前を保持する、NULL で終わる文字列へのポインタを指定します。
戻り値
関数が成功すると、登録されたクリップボードデータ形式を識別する値が返ります。
関数が失敗すると、0 が返ります。拡張エラー情報を取得するには、関数を使います。
解説
指定した名前のデータ形式が既に存在しているときは、新しいデータ形式は登録されず、既存のデータ形式を識別する値が返ります。この結果、複数のアプリケーションが同じ登録済みクリップボードデータ形式を使ってデータのコピーと貼り付けを行うことを防止できます。データ形式の名前を比較する際に、大文字と小文字を区別しないことに注意してください。
登録済みのクリップボードデータ形式は、0xC000～0xFFFF の範囲の値になります。
登録済みのクリップボードデータ形式をクリップボードに格納したり、クリップボードから取得する場合は、HGLOBAL 値の形式を使わなければなりません。

SetClipboardData

クリップボードに、指定されたデータ形式でデータを格納します。

データを格納するには、呼び出し側のウィンドウがクリップボードの現在のオーナーであること、および OpenClipboard 関数を使ってクリップボードを開いておくことが必要です。ただし、およびメッセージに応答する場合、クリップボードの所有者は SetClipboardData 関数を呼び出す前に OpenClipboard を呼び出してはなりません。

HANDLE SetClipboardData(
UINT uFormat, // クリップボードのデータ形式
HANDLE hMem // データのハンドル
);

パラメータ
uFormat
［入力］クリップボードのデータ形式を指定します。このパラメータには、登録済みデータ形式、または標準的なクリップボードデータ形式を指定します。詳細については、「」または「」を参照してください。
hMem
［入力］指定されたデータ形式のデータのハンドルを指定します。ウィンドウが要求に応じて、指定されたクリップボードデータ形式でデータを提供する（データ形式の遅延レンダリングを行う）場合は、NULL を指定します。遅延レンダリングを行う場合、ウィンドウはメッセージとメッセージを処理しなければなりません。
SetClipboardData を呼び出した後で、システムは、hMem パラメータで指定されたオブジェクトを所有します。アプリケーションはデータを読み取れますが、CloseClipboard 関数を呼び出すまでは、そのハンドルを解放することや、ロックし続けることを避けなければなりません。（CloseClipboard を呼び出した後も、アプリケーションはそのデータにアクセスできます。）hMem パラメータがメモリオブジェクトを指している場合、そのオブジェクトは、GMEM_MOVEABLE フラグを指定して関数で割り当てたものでなければなりません。
戻り値
関数が成功すると、データのハンドルが返ります。
関数が失敗すると、NULL が返ります。拡張エラー情報を取得するには、関数を使います。
解説
uFormat パラメータで、登録済みのクリップボード形式または標準的なクリップボード形式のいずれかを指定できます。詳細については、「」または「」を参照してください。
WM_RENDERFORMAT または WM_RENDERALLFORMATS メッセージに応答してアプリケーションが SetClipboardData を呼び出した場合、アプリケーションはその後にそのハンドルを使うべきではありません。
アプリケーションが GetClipboardData 関数を呼び出したとき、オペレーティングシステムがデータ形式の暗黙的な変換を行います。たとえば、CF_OEMTEXT のデータがクリップボードにある場合、アプリケーションはそのデータを CF_TEXT 形式のデータとして取り出すこともできます。クリップボード内のデータ形式は、必要に応じて、要求されたデータ形式へ変換されます。詳細については、「」を参照してください。

SetClipboardViewer

クリップボードビューアのチェインに、指定されたウィンドウを追加します。

クリップボードの内容が変更されると必ず、クリップボードビューアの各ウィンドウは WM_DRAWCLIPBOARD メッセージを受け取ります。

HWND SetClipboardViewer(
HWND hWndNewViewer // クリップボードビューアウィンドウのハンドル
);

パラメータ
hWndNewViewer
［入力］クリップボードのチェインに追加したいウィンドウのハンドルを指定します。
戻り値
関数が成功すると、クリップボードビューアのチェイン内で、追加したウィンドウの次に位置するウィンドウのハンドルが返ります。エラーが発生した場合、または、クリップボードビューアのチェイン内に他のウィンドウが存在しなかった場合は、NULL が返ります。拡張エラー情報を取得するには、関数を使います。
解説
クリップボードビューアのチェインに追加されたウィンドウ（クリップボードビューアウィンドウ）は、との各メッセージを処理しなければなりません。クリップボードビューアの各ウィンドウは、関数を呼び出して、これら 2 つのメッセージをクリップボードビューアのチェイン内の次のウィンドウに渡します。
クリップボードビューアのウィンドウは最終的に（たとえばメッセージ処理ルーチンで）、ChangeClipboardChain 関数を呼び出して、クリップボードビューアのチェインから自分自身を削除しなければなりません。

コピープロセス間通信クリップボードの関数一覧-2

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

一覧
GetClipboardFormatName
- クリップボードから、指定された登録済みデータ形式の名前を取得します。この関数はその名前を、指定されたバッファへコピーします。
GetClipboardOwner
- 現在クリップボードを所有しているウィンドウのハンドルを取得します。
GetClipboardSequenceNumber
- 現在のウィンドウステーションのクリップボードのシーケンス番号を取得します。
GetClipboardViewer
- クリップボードビューアのチェイン内にある最初のウィンドウのハンドルを取得します。
GetOpenClipboardWindow
- 現在クリップボードを開いているウィンドウのハンドルを取得します。
GetPriorityClipboardFormat
- 指定されたリストの中から、最初に利用できるクリップボードデータ形式を返します。

一覧

関数	説明
ChangeClipboardChain	クリップボードビューアのチェインから、指定されたウィンドウを削除します。
CloseClipboard	クリップボードを閉じます。
CountClipboardFormats	現在クリップボード内に存在するデータが持つデータ形式の数を取得します。
EmptyClipboard	クリップボードを空にし、クリップボード内のデータのハンドルを解放します。
EnumClipboardFormats	現在クリップボード内に存在するデータが持つデータ形式を列挙します。
GetClipboardData	クリップボードから、指定された形式のデータを取得します。
GetClipboardFormatName	クリップボードから、指定された登録済みデータ形式の名前を取得します。
GetClipboardOwner	現在クリップボードを所有しているウィンドウのハンドルを取得します。
GetClipboardSequenceNumber	現在のウィンドウステーションのクリップボードのシーケンス番号を取得します。
GetClipboardViewer	クリップボードビューアのチェイン内にある最初のウィンドウのハンドルを取得します。
GetOpenClipboardWindow	現在クリップボードを開いているウィンドウのハンドルを取得します。
GetPriorityClipboardFormat	指定されたリストの中から、最初に利用できるクリップボードデータ形式を返します。
IsClipboardFormatAvailable	指定されたデータ形式のデータがクリップボードに格納されているかどうかを調べます。
OpenClipboard	検討の目的でクリップボードを開き、他のアプリケーションがクリップボードの内容を変更できないようにします。
RegisterClipboardFormat	クリップボードの新しいデータ形式を Windows システムに登録します。
SetClipboardData	クリップボードに、指定されたデータ形式でデータを格納します。
SetClipboardViewer	クリップボードビューアのチェインに、指定されたウィンドウを追加します。

GetClipboardFormatName

クリップボードから、指定された登録済みデータ形式の名前を取得します。この関数はその名前を、指定されたバッファへコピーします。

int GetClipboardFormatName(
UINT format, // クリップボードから取得したいデータ形式
LPTSTR lpszFormatName, // 形式の名前
int cchMaxCount // データ形式名を保持するバッファの長さ
);

パラメータ
format
［入力］取得したいデータ形式を指定します。このパラメータは、あらかじめ定義されたデータ形式のいずれかでなければなりません。
lpszFormatName
［出力］データ形式の名前を受け取るバッファへのポインタを指定します。
cchMaxCount
［入力］バッファへコピーされる文字列の最大の長さを TCHAR 単位で指定します。データ形式の名前がこの最大値を上回る場合は、名前が切り捨てられます。
戻り値
関数が成功すると、バッファへコピーされた文字列の長さが TCHAR 単位で返ります。
関数が失敗すると、0 が返ります。これは、要求されたデータ形式が存在しないこと、またはあらかじめ定義されたものでないことを示します。拡張エラー情報を取得するには、関数を使います。

GetClipboardOwner

現在クリップボードを所有しているウィンドウのハンドルを取得します。

HWND GetClipboardOwner(VOID);

パラメータ
パラメータはありません。
戻り値
関数が成功すると、クリップボードを所有しているウィンドウのハンドルが返ります。
クリップボードが所有されていなかったときは、NULL が返ります。拡張エラー情報を取得するには、関数を使います。
解説
クリップボードは、ウィンドウに所有されていなくても、データを保持し続けることができます。クリップボードの所有者は、通常、クリップボードに最後にデータを格納したウィンドウです。EmptyClipboard 関数が、クリップボードの所有権を割り当てます。

GetClipboardSequenceNumber

現在のウィンドウステーションのクリップボードのシーケンス番号を取得します。

DWORD GetClipboardSequenceNumber(VOID)

パラメータ
パラメータはありません。
戻り値
クリップボードのシーケンス番号が返ります。ウィンドウステーションへの WINSTA_ACCESSCLIPBOARD アクセス権がない場合は、0 が返ります。
解説
システムでは、各ウィンドウステーションのクリップボードの 32 ビットのシーケンス番号が維持されています。クリップボードの内容が変更されたり、クリップボードの内容が消去されるたびに、このシーケンス番号はインクリメントされます。このため、この値を調るとクリップボードの内容が変更されたかどうかが確認できます。クリップボードのレンダリングが遅延した場合、変更箇所のレンダリングが終了するまでシーケンス番号はインクリメントされません。

GetClipboardViewer

クリップボードビューアのチェイン内にある最初のウィンドウのハンドルを取得します。

HWND GetClipboardViewer(VOID);

パラメータ
パラメータはありません。
戻り値
関数が成功すると、クリップボードビューアチェイン内にある最初のウィンドウのハンドルが返ります。
クリップボードビューアが存在しなかったときは、NULL が返ります。拡張エラー情報を取得するには、関数を使います。

GetOpenClipboardWindow

現在クリップボードを開いているウィンドウのハンドルを取得します。

HWND GetOpenClipboardWindow(VOID);

パラメータ
パラメータはありません。
戻り値
関数が成功すると、クリップボードを開いているウィンドウのハンドルが返ります。どのウィンドウもクリップボードを開いていない場合は、NULL が返ります。拡張エラー情報を取得するには、関数を使います。
解説
アプリケーションまたはダイナミックリンクライブラリ（DLL）が OpenClipboard 関数でウィンドウハンドルに NULL を指定した場合、クリップボードは開きますが、どのウィンドウとも関連付けられません。この場合、GetOpenClipboardWindow 関数は NULL を返します。

GetPriorityClipboardFormat

指定されたリストの中から、最初に利用できるクリップボードデータ形式を返します。

int GetPriorityClipboardFormat(
UINT *paFormatPriorityList, // クリップボードデータ形式の配列
int cFormats // 配列内のエントリの数
);

パラメータ
paFormatPriorityList
［入力］クリップボードのデータ形式を識別する符号なし整数の配列へのポインタを指定します。この配列に、クリップボードデータ形式を、優先順位の高い順に格納しておかなければなりません。クリップボードデータ形式の詳細については、「」を参照してください。
cFormats
［入力］paFormatPriorityList 配列のエントリ数を指定します。この値は、配列内のエントリ数以下でなければなりません。
戻り値
関数が成功すると、指定したリストの中から、クリップボードで最初に利用できるデータ形式が返ります。クリップボードが空のときは、NULL が返ります。クリップボードにデータが格納されていて、指定したフォーマットのどれとも一致しなかったときは、-1 が返ります。拡張エラー情報を取得するには、関数を使います。

WEB XMLParser(MSXML)を使いブラウザを通さずにソース情報取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

概要
<Open Method>
1. HTTPMethod
2. URL
3. [readyState Property]
4. [UserName]
5. [Password]
<abort Method>
<send Method>
<status Prroperty>
<statusText Property>
<getResponseHeader Method>
<getAllResponseHeaders Method>
<setRequestHeader Method>
<responseBody Property>
<responseStream Property>
<responseTerxt Property>
<responseXML Property>
<statusText Property>
<onreadystatechange Event>
<onload Event>
VBVBAサンプル

XMLHTTPクラスとXMLHttpRequestクラスの利用

XMLHTTPオブジェクトを生成します

概要

[Msxml2.XMLHTTP]
- 動作 IE4～IE6　動作 WindowsXP以上
- 例
  - Object = new ActiveXObject("Msxml2.XMLHTTP");
  - Object = CreateObject("MSXML2.XMLHTTP")
[Microsoft.XMLHTTP]
- 動作 IE4～IE6　動作 WindowsXP以下
- 例
  - Object = new ActiveXObject("Microsoft.XMLHTTP");
  - Object = CreateObject("Microsoft.XMLHTTP")
[XMLHttpRequest]
- 動作 IE4～IE6以外
- 例
  - Object = new ActiveXObject("Msxml.XMLHTTPRequest");
  - Object = CreateObject("MSXML.XMLHTTPRequest")
XMLHTTPオブジェクト
XMLファイル構文解析ライブラリ
XML Parser
XML対応COMコンポーネント(Microsoft)オブジェクト
XML処理のためのライブラリ
ActiveXコントロールとして利用
保存先
- C:\WINDOWS\system32
参考　http://msdn.microsoft.com/ja-jp/library/bb902797.aspx

<Open Method>

戻り値なし
動作
- リクエストの初期化 (リクエストの設定)
例
- MSXMLx.XMLHTTP.open HTTPMethod,URL *Option[,readyState,UserName,Password]
HTTPMethod
- GET,POST,PUT,PROPFINDが指定可能
- データ取得GETを指定
- データ送信POSTを指定
URL
- URLを指定

*Option[]内は省略可能

*Option
[readyState Property]

省略した場合はデフォルトのtrue（非同期）が適用されます

true

非同期データの送受信完了まで処理しない(規定値)
サーバーにリクエスト中の処理状態を取得

戻り値	説明
0	uninitialized 開始前の初期状態
1	loading リクエスト準備中
2	loaded リクエスト送信中
3	Interactive データ受信中データ解析中
4	complete データ受信解析完了又は失敗

false
- 同期データを取得した時点で処理

*Option
[UserName]
- 認証ダイアログ表示
- 省略可能 UserName ドメイン名\ユーザーID ドメイン認証
Option
[Password]
- 認証ダイアログ表示
- 省略可能 Password パスワードドメイン認証

<abort Method>

リクエストをキャンセル
戻り値なし
例
- MSXMLx.xmlHttp.abort

<send Method>

サーバーにリクエストを送信
戻り値なし
例
- MSXMLx.xmlHttp.send (Argument)
引数 Argument
- Post (文字), DOM, InputStreamが指定可能
- GET送信の場合は空文字列("")又はNULL値を指定
- Post (文字)
  - サーバーサイドスクリプトで受け取ったデータを処理させる場合
リクエストファイルのダウンロード完了後
- リクエストの返り値(レスポンスデータ)を取得することが可能
- プロパティ
  - responseXML XML形式で取得
  - responseText テキスト形式で取得

<status Property>

HTTPステータスコード(レスポンス)　Status-Code
Code
例
- MSXMLx.xmlHttp.status
HTTP HTTPステータスコード(レスポンス)一覧

<statusText Property>

HTTPステータスコード(レスポンス)　Reason-Phrase
Text
例
- MSXMLx.xmlHttp.statusText
HTTP HTTPステータスコード(レスポンス)一覧

<getResponseHeader Method>

指定したレスポンスヘッダを取得
ヘッダがない場合はNULLを返します
すべてのヘッダを取得する場合には<getAllResponseHeaders Method>
例
- MSXMLx.xmlHttp.getResponseHeader (Argument)
- 引数Argumentにはヘッダ名を指定

<getAllResponseHeaders Method>

すべてのレスポンスヘッダを取得
ヘッダがない場合はNULLを返します
特定のヘッダを取得する場合には<getResponseHeader Method>
例
- MSXMLx.xmlHttp.getAllResponseHeaders

<setRequestHeader Method>

特定のリクエストヘッダを設定｡
例
- MSXMLx.XMLHTTP.setRequestHeader(Argument1,Argument2)
- 引数Argument1にはヘッダ名
- 引数Argument2には値を指定

<responseBody Property>

バイナリデータを取得
レスポンスをバイト配列取得
IE のみで使用可

<responseStream Property>

レスポンスを IStream 形式取得
IE のみで使用可

<responseText Property>

レスポンスをテキスト形式取得｡

<responseXML Property>

レスポンスを XML DOM 形式取得。

<statusText Property>

HTTPステータスの詳細取得

<onreadystatechange Event>

[readyState Property] をtrueにした場合に使用
[readyState Property] が変化する度に呼び出されるイベントハンドラ
Microsoft Visual Basic または Visual C++ ですぐにアクセスできません
問題解決:http://support.microsoft.com/kb/303322/ja

<onload Event>

レスポンスデータのダウンロード完了後に発生
IEでの使用は未対応
IEでの使用は<onreadystatechange Event>を使用する

VB・VBAサンプル

Option Explicit

Sub GetMSXML(ByRef objMSXML As Object, ByRef blnErr As Boolean)
'***************************************************
'XML_Parser(MSXML)をObject定義する
'***************************************************
'リロードを伴わずにソース情報取得
'元々はXML形式のデータのやり取りを行うもの
'XML Parser
'JavaScriptではAjax(Asynchronous JavaScript + XML)

On Error Resume Next
    Set objMSXML = CreateObject("MSXML2.XMLHTTP") 'MSXML2Class
    If (Err.Number <> 0) Then
        Set objMSXML = CreateObject("Microsoft.XMLHTTP")
            If (Err.Number <> 0) Then
                Set objMSXML = CreateObject("MSXML.XMLHTTPRequest")
            End If
    End If

On Error GoTo 0
    If objMSXML Is Nothing Then
        blnErr = True
    Else
        blnErr = False
    End If

End Sub

Private Sub test_UserNamePassword()
'*********************************************
'同期データを取得した時点で処理
'*********************************************
'*********************************************
'"UserName", "Password"を設置
'*********************************************

Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String

'パラメータ
strURL = "http://www.yahoo.co.jp/"

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, False, "UserName", "Password"
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If
End With

End Sub

Private Sub test_readyState()
'*********************************************
'サーバーにリクエスト中の処理状態を取得
'*********************************************
Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String

'パラメータ
strURL = "http://www.yahoo.co.jp/"

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If
End With

End Sub

Private Sub test_getResponseHeader()
'*********************************************
'レスポンスヘッダ取得
'*********************************************
Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String
Dim lngStatus As Long, strSRC(5) As String
Dim blnRspns As Boolean
'パラメータ
strURL = "http://www.yahoo.co.jp/"

'全部のレスポンスヘッダ取得 =True
'個別のレスポンスヘッダ取得 =False
blnRspns = False

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If

    lngStatus = .status
    If (.status < 200 Or .status >= 300) Then
        Debug.Print lngStatus & vbTab & strStatus
        Exit Sub
    Else
        Debug.Print lngStatus & vbTab & strStatus
    End If

    If blnRspns = True Then
        strSRC(0) = .getAllResponseHeaders
    Else
        strSRC(1) = .getResponseHeader("ETag")
        strSRC(2) = .getResponseHeader("Content-Length")
        strSRC(3) = .getResponseHeader("Keep-Alive")
        strSRC(4) = .getResponseHeader("Content-Type")
        strSRC(5) = .getResponseHeader("Last-Modified")
    End If

    Dim i As Byte

    For i = 0 To 5
    Debug.Print strSRC(i)
    Next i

End With

End Sub

Private Sub test_responseXMLText()
'*********************************************
'XML又はTextで取得する
'*********************************************
'*********************************************
'Shift -JISをUnicodeに変換
'*********************************************

Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String
Dim lngStatus As Long, strStatus As String, strSRC As String
Dim XMLTXT As Byte, blnSJIS As Boolean

'パラメータ
strURL = "http://www.yahoo.co.jp/"

'パラメータ
'XMLデータ(responseXML) = 0
'TXTデータ(responseText) = 1
XMLTXT = 1

'パラメータ
'Shift-JIS  の場合 = True
'Unicode    の場合 = False
blnSJIS = False

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        DoEvents
        GoTo reTry:
    End If

    lngStatus = .status
    strStatus = .statusText
    If (.status < 200 Or .status >= 300) Then
        Debug.Print lngStatus & vbTab & strStatus
        Exit Sub
    Else
        Debug.Print lngStatus & vbTab & strStatus
    End If

    If XMLTXT = 0 Then
        'XML形式以外はエラーになります。
        strSRC = .responseXML
    Else
        strSRC = .responseText
    End If

    If blnSJIS = True Then
        strSRC = StrConv(.responseBody, vbUnicode)
    Else
        strSRC = .responseText
    End If

    Debug.Print strSRC
End With

End Sub

Private Sub test_abort()
'*********************************************
'中止する
'*********************************************

Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String

'パラメータ
strURL = "http://www.yahoo.co.jp/"

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If

    .abort
    MsgBox "Cancel!"
End With

End Sub

WEB フォーム上のブラウザ内容をテキスト形式で取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub UserForm_Initialize()
'Microsoft HTML Object Library を参照設定すること。
Dim URL As String

URL = "http://www.jp-ia.com/index2.htm"

Me.WebBrowser1.Navigate URL

End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim doc As MSHTML.HTMLDocument
Set doc = Me.WebBrowser1.Document

Me.TextBox1.Text = doc.body.innerText

Set doc = Nothing
End Sub

ダイアログフォルダ選択ダイアログを表示し選択パスを返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Function fncDialogFolder(strMsg As String) As String '全ドライブ
'**********************************************
'フォルダ選択ダイアログを表示し選択パスを返す
'**********************************************
Dim Shell, myPath, str As String

    Set Shell = CreateObject("Shell.Application")
    Set myPath = Shell.BrowseForFolder(&O0, strMsg & _
    "をするフォルダを選んでください", &H1 + &H10, "")
    If Not myPath Is Nothing Then
    str = myPath.Items.Item.Path & "\"
    Else 'キャンセルが押された場合の処置
    str = ""
    End If
    Set Shell = Nothing
    Set myPath = Nothing
    fncDialogFolder = str
End Function

Function BrowseFolder() As String
'**********************************************
'フォルダ選択ダイアログを表示し選択パスを返す
'**********************************************

Dim Shell
    Set Shell = CreateObject("Shell.Application") _
    .BrowseForFolder(&O0, "フォルダ選択", &H1 + &H10, 0)

    If Shell Is Nothing Then
        MsgBox "フォルダは選択されませんでした！", vbCritical
        BrowseFolder = ""
        Exit Function
    Else
        BrowseFolder = Shell.Items.Item.Path & "\"
    End If

End Function

Private Sub test()
MsgBox BrowseFolder
End Sub

ダイアログインプットボックス使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub MessageInputBox()
'***************************
'ダイアログボックスInputBox
'***************************

Dim Message, Title, Default, MyValue
Message = "1 から 3 までの値を入力してください。" ' 入力を求めるメッセージを設定します。
Title = "InputBox ﾃﾞﾓ" ' タイトルを設定します。
Default = "1" ' 既定値を設定します。
' メッセージ、タイトル、既定値を表示します。
MyValue = InputBox(Message, Title, Default)

' 状況依存のヘルプを設定します。ヘルプボタンが自動的に追加されます。
MyValue = InputBox(Message, Title, , , , "DEMO.HLP", 10)

' ダイアログボックスを位置 100,100 に表示します。
MyValue = InputBox(Message, Title, Default, 100, 100)

End Sub

ダイアログファイルを開くダイアログボックスを表示取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

GetOpenFilename メソッド

ユーザーからファイル名を取得するために、[ファイルを開く] ダイアログボックスを表示します。ダイアログボックスで指定したファイルは、実際には開かれません。

構文

expression.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)

expression 必ず指定します。対象となる Application オブジェクトを表すオブジェクト式を指定します。

FileFilter
省略可能です。バリアント型 (Variant) の値を使用します。開くファイルの種類を指定する文字列 (ファイルフィルタ文字列) を指定します。

ファイルフィルタ文字列とワイルドカードのペアを、必要な数だけ指定します。ファイルフィルタ文字列とワイルドカードはカンマ (,) で区切り、各ペアもカンマで区切って指定します。各ペアは、[ファイルの種類] ボックスのリストに表示されます。次にテキストファイルとアドインの 2 つのファイルフィルタを指定します。
"テキストファイル (*.txt),*.txt,アドインファイル (*.xla),*.xla"

1 つのファイルフィルタ文字列に複数のワイルドカードを対応させるには、次のように各ワイルドカードをセミコロン (;) で区切ります。
"Visual Basic ファイル (*.bas; *.txt),*.bas;*.txt"

この引数を省略すると "すべてのファイル (*.*),*.*" を指定したことになります。
FilterIndex
省略可能です。バリアント型 (Variant) の値を使用します。引数 FileFilter で指定したファイルフィルタ文字列の中で、最初の 1 から何番目を既定値とするかを指定します。この引数を省略するか、引数 FileFilter に含まれるファイルフィルタ文字列の数より大きい数値を指定すると、最初のファイルフィルタ文字列が既定値となります。
Title
省略可能です。バリアント型 (Variant) の値を使用します。ダイアログボックスのタイトルを指定します。この引数を省略すると "ファイルを開く" になります。
ButtonText
省略可能です。バリアント型 (Variant) の値を使用します。Macintosh のみ指定できます。
MultiSelect
省略可能です。バリアント型 (Variant) の値を使用します。True を指定すると、複数のファイルを選択できます。False を指定すると、1 つのファイルしか選択できません。既定値は False です。

解説

GetOpenFilename メソッドは、ユーザーによって選択、または入力したファイルの名前とパス名を返します。引数 MultiSelect が True の場合は、選択したファイルの名前の配列が返されます。選択されたファイルが 1 つでも、配列として返されます。入力が取り消された場合には False が返されます。

このメソッドを実行することによってカレントドライブや現在のフォルダが変更される可能性があります。

GetOpenFilename メソッドの使用例

次の使用例は、ファイルを開くときに表示されるダイアログボックスで、ファイルの種類をテキストファイルに限定して表示します。ファイル名を選択すると、そのファイル名がメッセージボックスに表示されます。

fileToOpen = Application _
.GetOpenFilename("テキストファイル (*.txt), *.txt")
If fileToOpen <> False Then
MsgBox "選択されたファイル : " & fileToOpen
End If

サンプル

Option Explicit

Function GetFilename() As String
'**********************************************
'ファイルを開くダイアログボックスを表示取得
'**********************************************
'選択なしの場合は空白が返る
Dim tmp As Variant, 種類 As String, タイトル As String

種類 = "JPG(*.jpg),*.jpg"
タイトル = "JPG画像を選択"

    tmp = Application.GetOpenFilename(FileFilter:=種類, FilterIndex:=1, Title:=タイトル)

    If tmp = False Then
        MsgBox "ファイルは選択されませんでした！", vbCritical
        GetFilename = ""
        Exit Function
    Else
        GetFilename = tmp
    End If
End Function

Private Sub test()
MsgBox GetFilename
End Sub

ダイアログ印刷ダイアログボックスを表示する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub 印刷ダイアログボックスを表示する()
'*********************************************
'印刷ダイアログボックスを表示する
'*********************************************
Application.Dialogs(xlDialogPrint).Show
End Sub

ダイアログメッセージMsgBox関数の定数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'コピペ用VBE用に空白スペース
'************************************************************************************
'MsgBox関数の引数の値
'************************************************************************************
'定数                           値       内容
'-----------------------------------------------------------------------------------
'vbOKOnly                        0       (既定値)[OK]ボタンのみを表示します。
'vbOKCancel                      1       [OK]ボタンと[キャンセル]ボタンを表示します。
'vbAbortRetryIgnore              2       [中止]、[再試行]、[無視]の3つのボタンを表示します。
'vbYesNoCancel                   3       [はい]、[いいえ]、[キャンセル]の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              0       (既定値)アプリケーションモーダルに設定します。
'vbSystemModal                4096       システムモーダルに設定します。
'vbMsgBoxHelpButton          16384       ヘルプボタンを追加します。
'VbMsgBoxSetForeground       65536       最前面のウィンドウとして表示します。
'vbMsgBoxRight              524288       テキストを右寄せで表示します。
'vbMsgBoxRtlReading        1048576       テキストを、右から左の方向で表示します。

'************************************************************************************
'MsgBox関数の戻り値
'************************************************************************************
'定数-----------値-------内容
'-----------------------------------------------------------------------------------
'vbOK------------1-------[OK]
'vbCancel--------2-------[キャンセル]
'vbAbort---------3-------[中止]
'vbRetry---------4-------[再試行]
'vbIgnore--------5-------[無視]
'vbYes-----------6-------[はい]
'vbNo------------7-------[いいえ]

パスワードパスワードを使用しブックを開きCol数を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function psbブックを開きCOL数取得(myPath As String) As Long
'*******************************************************************************
'パスワードを使用しブックを開きＣＯＬ数を返す
'*******************************************************************************
Dim BokName As String, Bok As Workbook, b As Long
Dim i, cnt As Integer
    Workbooks.Open Filename:=(myPath), ReadOnly:=False, Password:=fncPass
    BokName = Dir(myPath)
    Set Bok = Workbooks(BokName)
        b = 0
        With Bok
            cnt = .Sheets.Count
                For i = 1 To cnt
                If .Sheets(i).Name = "Sheet1" Then
                    b = .Sheets(i).Range("IV1").End(xlToLeft).Column
                    Exit For
                End If
            Next
        End With
    Set Bok = Nothing
        psbブックを開きCOL数取得 = b
End Function

セルセルに設置されたハイパーリンクを取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub CellsHyperlinkGet()
'************************************
'セルに設置されたハイパーリンクを取得
'************************************
'・リンクの右隣に各プロパティに分けます
'・値・リンク数・リンク・サブアドレス
'・参照セルのリンクは削除します
'・リンク数文字に取得したリンクを設置

Dim sht As Worksheet
Dim i As Long
Dim Col As Long 'Columns
Dim Rng(5) As Range
Dim RangeValue As String
Dim HyperlinksCount As Long
Dim HyperlinkAddress As String
Dim HyperlinkSubAddress As String

Set sht = ThisWorkbook.Worksheets("Sheet1")

Col = 1 'リンク設置列
With sht
    For i = 1 To .Cells(65536, Col).End(xlUp).Row
        Set Rng(1) = .Cells(i, Col)     '参照セル
        Set Rng(2) = .Cells(i, Col + 1) '値
        Set Rng(3) = .Cells(i, Col + 2) 'リンク数
        Set Rng(4) = .Cells(i, Col + 3) 'リンク
        Set Rng(5) = .Cells(i, Col + 4) 'サブアドレス
        'セル値の取得
        RangeValue = Rng(1).Value
        Rng(2).Value = RangeValue
        'リンクの設置数取得
        HyperlinksCount = Rng(1).Hyperlinks.Count
        Rng(3).Value = HyperlinksCount
        If HyperlinksCount <> 0 Then '在れば
            'リンク取得
            HyperlinkAddress = Rng(1).Hyperlinks(1).Address
            Rng(4).Value = HyperlinkAddress
            'サブアドレス取得
            HyperlinkSubAddress = Rng(1).Hyperlinks(1).SubAddress
            Rng(5).Value = HyperlinkSubAddress
            'リンク設置
            .Hyperlinks.Add Rng(3), HyperlinkAddress
            'リンク削除
            Rng(1).Hyperlinks.Delete
        End If
        Set Rng(1) = Nothing
        Set Rng(2) = Nothing
        Set Rng(3) = Nothing
        Set Rng(4) = Nothing
        Set Rng(5) = Nothing
    Next i
End With

''【その他】
''図形 1 のハイパーリンク先をセル範囲 A1:B10 に設定します。
'    Worksheets(1).Shapes(1).Hyperlink.SubAddress = "A1:B10"
''図形 1 に接続されたハイパーリンク先の文書をロードします。
'    Worksheets(1).Shapes(1).Hyperlink.Follow NewWindow:=True
''図形は、ハイパーリンクを 1 つだけ持つことができます。
''図形 1 のハイパーリンクをアクティブにします。
'    Worksheets(1).Shapes(1).Hyperlink.Follow NewWindow:=True
''引数 index には、ハイパーリンク番号を指定します。
''セル範囲 A1:B2 のハイパーリンクをアクティブにします。
'    Worksheets(1).Range("A1:B2").Hyperlinks(2).Follow

End Sub

セルセルデータを抽出するAdvancedFilter

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

shtTarget6.Columns("A:c").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=shtTarget5.Range("a1:d2"), CopyToRange:=shtTarget4.Range("a1"), Unique:=True

セルセルデータを並べ替え

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

With shtENDefc
.Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End With

セル CellsとRange及びColumns

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub Test()
Dim sht As Worksheet
Set sht = ThisWorkbook.ActiveSheet

'以下は両方同じ意味
With sht
'Cellsでの記述の場合
    .Cells(1, 1).Value = 2
    .Columns(1).ClearContents

'Rangeでの記述の場合
    .Range("A1").Value = 2
    .Columns("A:A").ClearContents
End With

End Sub

セル A列最終行取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function Fnc最終行(obj As Worksheet) As Long
'*******************************************************************************
'A列最終行取得
'*******************************************************************************
Fnc最終行 = obj.Range("a65536").End(xlUp).Row
End Function

セル Sortメソッドの使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'次の使用例は、シート 1 のセル範囲 A1:C20 を並べ替えます。セル A1 を最優先させるキーフィールド、セル B1 を 2 番目に優先させるキーフィールドとし、昇順になるように行単位で並べ替えます。範囲の先頭行も、見出しではなく、データとして扱われます。

Worksheets("Sheet1").Range("A1:C20").Sort _
    Key1:=Worksheets("Sheet1").Range("A1"), _
    Key2:=Worksheets("Sheet1").Range("B1")
'次の使用例は、シート 1 のセル A1 を含むアクティブセル領域を並べ替えます。列 A をキーフィールドとし、見出し行があるかどうかは自動的に判断して、タイトル行以外の行を並べ替えます。並べ替えの範囲が指定されていないので、アクティブセル領域が範囲になります。

Worksheets("Sheet1").Range("A1").Sort _
    Key1:=Worksheets("Sheet1").Columns("A"), _
    Header:=xlGuess

シート指定ブックにある全てのシートを保護する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ExcelSheetAllProtect()
'***************************************
'指定ブックにある全てのシートを保護する
'***************************************
'指定ブックも保護
'引数によりマクロからは変更可能

Dim bok As Workbook, Sht As Worksheet
Dim strMSG As String, i As Long, strPass As String

strPass = PassName 'パスワード設定（すべて同じパスワード）

Set bok = ThisWorkbook

Application.ScreenUpdating = False

'ブック保護
bok.Protect Password:=strPass, Structure:=True, Windows:=False

i = 0
    For Each Sht In bok.Worksheets
        With Sht
           i = i + 1
           strMSG = strMSG & i & vbTab & .Name & vbCr
           'シート保護
           .Protect Password:=strPass, DrawingObjects:=True, Contents:=True, _
           Scenarios:=True, UserInterfaceOnly:=True
        End With
    Next Sht

Application.ScreenUpdating = True

MsgBox strMSG, vbInformation, "保護完了"

'-------------------------------------------------------------------------------------------
'【引数】
'-------------------------------------------------------------------------------------------
'Password           省略可
'   シートまたはブックのパスワード文字列を指定します。
'   パスワードでは大文字と小文字を区別します。
'-------------------------------------------------------------------------------------------
'DrawingObjects     省略可  既定値 False
'   描画オブジェクトを保護させるには、True を指定します。
'-------------------------------------------------------------------------------------------
'Contents           省略可  既定値 True
'   オブジェクトの内容を保護させるには、True を指定します。
'   この引数による保護対象は、グラフの場合はグラフ全体、ワークシートの場合はセルです。
'-------------------------------------------------------------------------------------------
'Scenarios          省略可  既定値 True
'   シナリオを保護するには、True を指定します。
'   この引数はワークシートの場合のみ有効です。
'-------------------------------------------------------------------------------------------
'Structure          省略可  既定値 False
'   ブックの構造 (各シートの相対位置) を保護するには、True を指定します。
'-------------------------------------------------------------------------------------------
'UserInterfaceOnly  省略可
'   True を指定すると、画面上からの変更は保護されますが、マクロからの変更は保護されません。
'   この引数を省略すると、マクロからも、画面上も変更することができなくなります。
'-------------------------------------------------------------------------------------------
'Windows            省略可
'   シートまたはブックのウィンドウを保護するには、True を指定します。
'   この引数を省略すると、ウィンドウは保護されません。
'-------------------------------------------------------------------------------------------
End Sub

Sub ExcelSheetAllUnProtect()
'*******************************************
'指定ブックにある全てのシートを保護解除する
'*******************************************
'指定ブックも保護解除

Dim bok As Workbook, Sht As Worksheet
Dim strMSG As String, i As Long, strPass As String

strPass = PassName 'パスワード設定（すべて同じパスワード）

Set bok = ThisWorkbook

Application.ScreenUpdating = False

'ブック保護解除
bok.Unprotect Password:=strPass

i = 0
    For Each Sht In bok.Worksheets
        With Sht
           i = i + 1
           strMSG = strMSG & i & vbTab & .Name & vbCr
           'シート保護解除
           .Unprotect Password:=strPass
        End With
    Next Sht

Application.ScreenUpdating = True

MsgBox strMSG, vbInformation, "保護解除完了"

End Sub

シートページ番号を1000加えてフッターに設定する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub ページ番号を1000加えてフッターに設定する()
'******************************************************
'ページ番号を1000加えてフッターに設定する
'******************************************************

ActiveSheet.PageSetup.CenterFooter = "&p+1000"
End Sub

シートシート全てをコピーする

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub test()

With ThisWorkbook
.Sheets("Sheet1").Copy Before:=.Sheets("Sheet1")
End With
'又は
With ThisWorkbook
.Sheets("Sheet1").Copy Before:=.Sheets(1)
End With

End Sub

シートページの詳細設定するPageSetup

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub ページの詳細設定する()
'******************************
'ページの詳細設定する
'******************************
'＜コメント＞
'※1 この行の下の28行は必要なものだけ記入
'※２ $1:$10には行タイトルの上端と下端セル番号を記入
'※３ $A:$Eには列タイトルの左端と右端セル番号を記入
'※４ $A$1:$E$30には印刷範囲の左上と右下セル番号を記入
'※5 InchesToPointsをCentimetersToPointsに変えるとcm指定可能
'※６ PaperSizeプロパティの定数一覧表はこちら（Macintoshでは指定不可能）
'※7 xlAutomatic: 自動整数: その番号から
'※８ xlDownThenOver または xlOverThenDown
'※９ 10～400%以内で指定 False:しない
'※10 FitToPagesWide、FitToPagesTallを指定する場合は Zoomを falseにする
'※11 xlPrintErrorsDisplayed:そのまま、xlPrintErrorsBlank : 空白に、xlPrintErrorsDash : ダッシュに、xlPrintErrorsNA : #N/Aと

    With ActiveSheet.PageSetup                  '※１
        .PrintTitleRows = "$1:$10"              '行タイトル ※２
        .PrintTitleColumns = "$A:$E"            '列タイトル ※３
        .PrintArea = "$A$1:$E$30"               '印刷範囲 ※４
        .LeftMargin = Application.InchesToPoints(0.787)   '左余白（25.2mmに対する％）※５
        .RightMargin = Application.InchesToPoints(0.787)  '右〃
        .TopMargin = Application.InchesToPoints(0.984)    '上〃
        .BottomMargin = Application.InchesToPoints(0.984) '下〃
        .HeaderMargin = Application.InchesToPoints(0.512) 'ヘッダー余白
        .FooterMargin = Application.InchesToPoints(0.512) 'フッター〃
        .PrintHeadings = False                  '行列番号 True:印刷する  False:しない
        .PrintGridlines = False                 'セル枠線 True:印刷する  False:しない
        .PrintNotes = False                     'セルメモ True:印刷する  False:しない
        .PrintQuality = 300                     '印刷品質（ドライバ制約に注意）
        .CenterHorizontally = False             '水平中央寄せ True:する  False:しない
        .CenterVertically = False               '垂直中央寄せ True:する  False:しない
        .Orientation = xlPortrait               '印刷の向き xlPortrait:縦  xlLandscape:横
        .Draft = False                          '簡易印刷 True:する  False:しない
        .PaperSize = xlPaperA4                  '用紙サイズ xlPaperA4:A4 ※６
        .FirstPageNumber = xlAutomatic          '先頭ページ番号 ※７
        .Order = xlDownThenOver                 'ページ付番順 ※８
        .BlackAndWhite = False                  '白黒印刷 True:する  False:しない
        .Zoom = 100                             '印刷倍率 ※９
        .FitToPagesWide = 1                     '横 1ページに印刷 ※10
        .FitToPagesTall = 1                     '縦 1   〃   ※10
'        .PrintErrors = xlPrintErrorsDisplayed   'セルのエラー ※11
    End With
End Sub

シート指定ブックの指定名称シートを削除する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Sub シート削除(Book As Workbook, SheetName As String)
'*******************************************************************************
'指定ブックの指定名称シートを削除する
'*******************************************************************************
    Application.DisplayAlerts = False
    Book.Worksheets(SheetName).Delete
    Application.DisplayAlerts = True
End Sub

シート指定ブックにある全てのシート名を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ExcelSheetAllName()
'*****************************************
'指定ブックにある全てのシート名を取得する
'*****************************************

Dim bok As Workbook, Sht As Worksheet
Dim strMSG As String, i As Long

Set bok = ThisWorkbook

Application.ScreenUpdating = False
i = 0
    For Each Sht In bok.Worksheets
        With Sht
           i = i + 1
           strMSG = strMSG & i & vbTab & .Name & vbCr

        End With
    Next Sht
Application.ScreenUpdating = True

MsgBox strMSG

End Sub

シート列挙したシート名を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Function ファイル列挙シート名(tgtPath As String) As String
'***********************************************
'指定フォルダ内のファイルの一覧を取得列挙する。
'返値：列挙したシート名を返す
'拡張子指定可能
'***********************************************
'引数：tgtPath には取得列挙するフォルダフルパスを指定

Dim buf As String, i As Long, sht As Worksheet
Dim 拡張子指定 As String, X As String

拡張子指定 = "jpg" '指定してください
'指定しない場合は-------------------
'拡張子指定 = "*"
'-----------------------------------

Set sht = ThisWorkbook.Worksheets.Add

    buf = Dir(tgtPath & "\*." & 拡張子指定)
    Do While buf <> ""
        i = i + 1
        sht.Cells(i, 1) = buf
        buf = Dir()
    Loop
X = sht.Name
Set sht = Nothing
ファイル列挙シート名 = X

End Function

セル範囲を指定し並び替える

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ExcelSort()
'*************************************
'セル範囲を指定し並び替える
'*************************************
Dim sht As Worksheet, rng As Range
Dim Key(2) As Range

Set sht = ThisWorkbook.Worksheets("SubIndex")
Set rng = sht.Columns("A:D")
Set Key(1) = sht.Range("C1")
Set Key(2) = sht.Range("D1")

With sht
    rng.Sort Key1:=Key(1), Order1:=xlAscending, Key2:=Key(2) _
    , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
    False, Orientation:=xlTopToBottom
End With

'Header:=xlGuess            範囲の先頭行自動判別
'Header:=xlYes              範囲の先頭行見出しとして
'Header:=xlNo               範囲の先頭行見出しではなくデータとして
'Order1:=xlAscending        昇順
'Order2:=xlDescending       降順
'OrderCustom:=1             リストの何番目に表示するか
'Orientation:=xlTopToBottom
'Orientation:=xlSortColumn  左から右に並べ替え
'Orientation:=xlSortRows    上から下に並べ替え
'MatchCase:=False           大文字小文字区別

'解説

'引数である Header、Order1、Order2、Order3、OrderCustom、Orientation で指定した値は
'このメソッドが実行されるたびに保持されます。
'これらの引数を省略してメソッドを実行した場合、
'保存されていた値が使用されます。
'問題の発生を防ぐため、このメソッドを実行するたびに、これらの引数を明確に指定します。

End Sub

セル最終行列取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'最終行・最大行数の取得

ActiveSheet.UsedRange.Rows.Count
ActiveSheet.Range("a1").CurrentRegion.Rows.Count
ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row

'最終列・最大列数の取得

ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Range("a1").End(xlToRight).Column
ActiveSheet .Range("A1").SpecialCells(xlCellTypeLastCell).Column

セル指定セルを上方向に削除

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ExcelCellUpDelete()
'***********************
'指定セルを上方向に削除
'***********************

Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Sheet1")

With sht
.Range(.Cells(3, 2), .Cells(5, 2)).Delete Shift:=xlUp
End With

'左方向に削除 Selection.Delete Shift:=xlUp
'行全体を削除 Selection.Delete Shift:=xlToLeft
'列全体を削除 Selection.EntireColumn.Delete

End Sub

セルデータが連続しているセル範囲(表)全部のデータを変数へ格納(コードたった１行)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub CellRangeListData(ByVal Sht As Worksheet, ByRef RngDB As Variant)
'***************************************************************************
'データが連続しているセル範囲(表)全部のデータを変数へ格納(コードたった１行)
'***************************************************************************
'Cell(1,1)からデータが入っていることが条件
'[Shift]+[Ctrl]+[*]と同じ範囲

RngDB = Sht.Cells(1, 1).CurrentRegion

End Sub

Private Sub test()
Dim Sht As Worksheet
Dim RngDB As Variant
Dim y As Long, x As Long

Set Sht = ThisWorkbook.Worksheets("Sheet1")
Call CellRangeListData(Sht, RngDB)
    For y = LBound(RngDB) To UBound(RngDB)
        For x = LBound(RngDB, 2) To UBound(RngDB, 2)
            Debug.Print RngDB(y, x)
        Next x
    Next y
'a
'b
'c
Set Sht = Nothing

End Sub

セルデータが連続しているセル範囲(表)の最後の行数と列数を取得(コードたった１行)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub CellRangeListRowCol(ByVal Sht As Worksheet, ByRef r As Long, ByRef c As Long)
'******************************************************************************
'データが連続しているセル範囲(表)の最後の行数と列数を取得(コードたった１行)
'******************************************************************************
'Cell(1,1)からデータが入っていることが条件
'[Shift]+[Ctrl]+[*]と同じ範囲

Dim RngDB As Variant
    RngDB = Sht.Cells(1, 1).CurrentRegion
    r = UBound(RngDB)
    c = UBound(RngDB, 2)

End Sub

Private Sub test()
Dim Sht As Worksheet
Dim r As Long, c As Long

Set Sht = ThisWorkbook.Worksheets("Sheet1")
Call CellRangeListRowCol(Sht, r, c)
Debug.Print r
Debug.Print c
Set Sht = Nothing

'6
'4

End Sub

セルデータを項目別に変数に格納する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ExcelReDimPreserve()
'*************************************
'セルデータを項目別に変数に格納する
'*************************************
Dim sht As Worksheet, strCat() As String
Dim i As Long, Newstr As String, j As Long
Dim Oldstr As String, CellData() As String
Dim cntData As Long, cntCat As Long, ttl() As Long

Set sht = ThisWorkbook.Worksheets("SubIndex")
Oldstr = ""
j = 0

With sht
    ExcelSort '事前に並べ替え
    cntData = .Cells(65536, 1).End(xlUp).Row
    ReDim CellData(cntData, 3) As String
    '見出しが無いデータと仮定
    For i = 1 To cntData
        Newstr = Trim(.Cells(i, 3).Value)
        If Oldstr <> Newstr Then
            j = j + 1
            ReDim Preserve strCat(j) As String
            ReDim Preserve ttl(j) As Long
            strCat(j) = Newstr
            Oldstr = Newstr
            CellData(i, 0) = j
            CellData(i, 1) = .Cells(i, 2).Value
            CellData(i, 2) = .Cells(i, 3).Value
            CellData(i, 3) = .Cells(i, 4).Value
            ttl(j) = ttl(j) + 1
        Else
            CellData(i, 0) = j
            CellData(i, 1) = .Cells(i, 2).Value
            CellData(i, 2) = .Cells(i, 3).Value
            CellData(i, 3) = .Cells(i, 4).Value
            ttl(j) = ttl(j) + 1
        End If
    Next i
End With

For cntCat = 1 To j
    Debug.Print cntCat & " " & strCat(cntCat) & " (" & ttl(cntCat) & ")"
    For i = 1 To cntData
        If CellData(i, 0) = cntCat Then
            Debug.Print " " & CellData(i, 3) & " " & CellData(i, 1)
        End If
    Next i
Next cntCat

End Sub

セル最終行・列の取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'最終行の取得
'
'例1
'アンプロテクトしないと取得不可
Suu = shtTarget4.Range("a1").CurrentRegion.Rows.Count - 1

'例2
'プロテクトされているシートでも取得可能
lngTextSUU = shtOpenText.Range("A65536").End(xlUp).Row

A = shtT.Range("a1").End(xlDown).Row

'最終列の取得
'
'例1
'アンプロテクトしないと取得不可
Suu = shtTarget4.Range("a1").CurrentRegion.Columns.Count - 1

'例2
'プロテクトされているシートでも取得可能
A = shtT.Range("a1").End(xlToRight).Column

'注意: 他にも方法はあります｡

エラーマクロブックが読み取り専用で開いてしまう(VBE6.DLLエラー)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

次の方法で回避できる場合もあります｡

1	[Alt]+[Ctrl]+[Del]で｢EXCEL｣を終了
2	マクロのないブックを開く
3	[ツール][マクロ][セキュリティ][セキュリティレベル][中]に設定
4	[保存][閉じる]
5	問題のマクロブックを開く
6	マクロを無効で開く
7	[ツール][マクロ][セキュリティ][セキュリティレベル][低]に設定
8	[保存][閉じる]

エラートラップできるエラー一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

トラップできるエラー

トラップできるエラーは、アプリケーションの実行中に発生します。トラップできるエラーのいくつかは、デザイン時またはコンパイル時にも発生します。On Error ステートメントおよび Err オブジェクトの Number プロパティを使用して、トラップできるエラーのテストおよびエラーへの対応を行うことができます。エラー番号 1 ～ 1000 の範囲で、使用されていない番号は、Visual Basic で予約されています。

番号	メッセージ
3	Return に対応する GoSub がありません。
5	プロシージャの呼び出し、または引数が不正です。
6	オーバーフローしました。
7	メモリが足りません。
9	インデックスが有効範囲にありません。
10	この配列は固定されているか、または一時的にロックされています。
11	0 で除算しました。
13	型が一致しません。
14	文字列領域が不足しています。
16	式が複雑すぎます。
17	要求された操作は実行できません。
18	ユーザーによる割り込みが発生しました。
20	エラーが発生していないときに Resume を実行することはできません。
28	スタック領域が不足しています。
35	Sub、Function、または Propertyが定義されていません。
47	コードリソースまたは DLL のクライアントアプリケーションが多すぎます。
48	コードリソースまたは DLL 読み込み時のエラーです。
49	コードリソースまたは DLL が正しく呼び出せません。
51	内部エラーです。
52	ファイル名または番号が不正です。
53	ファイルが見つかりません。
54	ファイルモードが不正です。
55	ファイルは既に開かれています。
57	デバイス I/O エラーです。
58	既に同名のファイルが存在しています。
59	レコード長が一致しません。
61	ディスクの空き容量が不足しています。
62	ファイルにこれ以上データがありません。
63	レコード番号が不正です。
67	ファイルが多すぎます。
68	デバイスが準備されていません。
70	書き込みできません。
71	ディスクが準備されていません。
74	ディスク名は変更できません。
75	パス名が無効です。
76	パスが見つかりません。
91	オブジェクト変数または With ブロック変数が設定されていません。
92	For ループが初期化されていません。
93	パターン文字列が不正です。
94	Null の使い方が不正です。
97	オブジェクトが定義クラスのインスタンスではない場合、このオブジェクトに関するフレンド関数は呼び出せません。
98	プロパティまたはメソッドの呼び出しの場合には、引数または戻り値としてプライベートオブジェクトへの参照を含めることはできません。
298	システムリソースまたは DLL をロードできません。
320	キャラクタデバイスは使えません。
321	不正なファイル形式です。
322	必要なテンポラリファイルを作成できません。
325	リソースファイルの形式が不正です。
327	データ値が見つかりません。
328	不正なパラメータです。配列に書き込めません。
335	システムレジストリにアクセスできません。
336	コンポーネントが正しく登録されていません。
337	コンポーネントが見つかりません。
338	コンポーネントが正常に実行されませんでした。
360	このオブジェクトは既にロードされています。
361	このオブジェクトは、ロードまたはアンロードすることはできません。
363	指定されたコントロールが見つかりません。
364	既にアンロードされています。
365	現在アンロードできません。
368	ファイルは古い形式で作成されています。このプログラムには新しい形式のファイルが必要です。
371	指定されたオブジェクトは、Show メソッドのオーナーフォームとして使用できません。
380	プロパティの値が不正です。
381	プロパティ配列のインデックスが不正です。
382	プロパティは、実行時には設定できません。
383	プロパティは値の取得のみ可能です。
385	このプロパティには配列のインデックスが必要です。
387	プロパティは値を設定できません。
393	プロパティは実行時に値の取得はできません。
394	プロパティは設定のみ可能です。
400	既にフォームは表示されています。モーダルにできません。
402	一番手前 (前面) のモーダルフォームを先に閉じてください。
419	オブジェクトを利用できません。
422	プロパティが見つかりません。
423	プロパティまたはメソッドが見つかりません。
424	オブジェクトが必要です。
425	オブジェクトの使い方が不正です
429	コンポーネントはオブジェクトを作成できません。
430	クラスはオートメーションをサポートしていません。
432	オートメーションの操作中にファイル名またはクラス名を見つけられませんでした。
438	オブジェクトは、このプロパティまたはメソッドをサポートしていません。
440	オートメーションエラーです。
442	リモートプロセス用のタイプライブラリまたはオブジェクトライブラリへの参照は失われました。
443	オートメーションオブジェクトには既定値がありません。
445	オブジェクトはこの動作をサポートしていません。
446	オブジェクトは名前付き引数をサポートしていません。
447	オブジェクトは現在の国別情報の設定をサポートしていません。
448	名前付き引数が見つかりません。
449	引数は省略できません。または不正なプロパティを指定しています。
450	引数の数が一致していません。または不正なプロパティを指定しています。
451	このオブジェクトがコレクションではありません。
452	序数が不正です。
453	関数は指定されたコードリソースには定義されていません。
454	コードリソースが見つかりません。
455	コードリソースのロックエラー
457	このキーは既にこのコレクションの要素に割り当てられています。
458	Visual Basic でサポートされていないオートメーションが変数で使用されています。
459	このコンポーネントでは、イベントはサポートされていません。
460	クリップボードのデータ形式が不正です。
461	メソッドまたはデータメンバが見つかりません。
462	リモートサーバーがないか、使用できる状態ではありません。
463	ローカルマシンにクラスが登録されていません。
480	AutoRedraw イメージを作成できません。
481	ピクチャが不正です。
482	プリンタエラーです。
483	プリンタドライバは指定されたプロパティをサポートしていません。
484	システムからプリンタ情報を受けるときに問題が発生しました。プリンタが正しく設定されているかを確かめてください。
485	ピクチャの形式が不正です。
486	フォームのイメージをこのプリンターで印刷することはできません。
520	クリップボードを空にできません。
521	クリップボードを開けません。
735	テンポラリファイルに保存できません。
744	検索文字列が見つかりませんでした。
746	置換後の文字列が長すぎます。
31001	メモリが不足しています。
31004	オブジェクトがありません。
31018	クラスが設定されていません。
31027	オブジェクトをアクティブにできません。
31032	埋め込みオブジェクトが作成できません。
31036	ファイルへの書き込み中にエラーが発生しました。
31037	ファイルの読み込み中にエラーが発生しました。

エラープロジェクトまたはライブラリが見つかりません

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

見つからない参照は、前に "MISSING" "参照不可"が付加されて、[参照設定] ダイアログボックスに表示されます。

見つからない参照を選択して､パスと見つからないプロジェクトまたはライブラリの言語を表示します｡
参照不可のエラーを解消するには（HELP抜粋）
1. [参照設定] ダイアログボックスを表示。
2. 見つからない参照を選択。
3. オブジェクトブラウザを起動。[F2]
  - ※オブジェクトブラウザ
  - 現在のプロジェクトで利用できるすべてのオブジェクト、プロシージャ、メソッド、プロパティなどの項目の一覧を表示するダイアログボックス｡
4. [検索文字列] ボックスを使用して、見つからない参照を探す。
5. [OK] をクリックします。
6. すべての参照が見つかるまで､上記の手順を繰り返します｡
7. 参照が見つかると、"MISSING""参照不可" が消えて、リンクが再構築されたことがわかります。
参照先プロジェクトのファイル名が変更されている場合は新しい参照を追加し､前の参照は削除しておく必要があります｡
参照先プロジェクト
- 現在作業中のプロジェクトから直接リンクを作成したプロジェクト｡
- カレントプロジェクトの直接参照先プロジェクトから､さらに参照されているプロジェクトを間接参照先プロジェクトと呼びます｡
- この間接参照先プロジェクトの Public として宣言された変数は、正確なプロジェクト名を使用して参照する場合を除いて、カレントプロジェクトから参照することはできません｡
- プロジェクト間の直接および間接の参照の組み合わせは､循環しないかぎり正しく動作します｡
- たとえば､ProjectA が ProjectB を参照し、ProjectA と ProjectB の両方が ProjectC を参照できるとします。
- この場合、ProjectB、および ProjectC は、循環参照になってしまうような ProjectA の参照はできません。
- 不要になった参照を削除するにはその参照のチェックボックスをオフにするだけです｡
- ただし、Visual Basic オブジェクトライブラリとホストアプリケーションオブジェクトライブラリへの参照は削除できません。
※オブジェクトライブラリ
- 使用可能なオブジェクトについての情報を Visual Basic などのオートメーションコントローラに情報を提供する、拡張子 ".OLB " を持つファイル。オブジェクトブラウザを使うと、特定のオブジェクトライブラリの内容を調べて、利用可能なオブジェクトについて知ることができます｡
※ホストアプリケーション
- Microsoft Visual Basic Programming System Applications Edition (アプリケーション用に開発されたMicrosoft Visual Basic) をサポートしているアプリケーション。
- たとえば、Microsoft Excel 97や Microsoft Word 97 などがあります。
- アプリケーションによっては､それぞれ言語バージョンの異なるオブジェクトライブラリをサポートしている場合があります｡
- どの言語バージョンが必要なのかを知るには､参照をクリックしてダイアログボックスの下に表示される言語を確認します｡
- オブジェクトライブラリは、拡張子 .OLB のスタンドアローンファイルにすることができ、ダイナミックリンクライブラリ (DLL) に組み込むこともできます。
※ダイナミックリンクライブラリ (DLL)
- 実行時に読み込まれて､アプリケーションにリンクされるルーチンで構成されるライブラリファイル｡
- DLL は、C、MASM、FORTRAN などの言語で作成されます。
- オブジェクトライブラリは､各プラットフォーム用に異なった言語バージョンを置いておくことができます｡
- したがって、プロジェクトを、たとえば Macintosh から Microsoft Windows に移行するときは、そのプラットフォームの参照先ライブラリに対応した言語バージョンが､ホストアプリケーションのマニュアルで指定されている場所に格納されている必要があります｡
- オブジェクトライブラリのファイル名は
- Windows (バージョン 3.1 以前): アプリケーションコード + 言語コード + [バージョン].OLB。次に例を示します。
- French Visual Basic for Applications の Version 2 のオブジェクトライブラリは vafr2.olb になります。
- French Microsoft Excel 5.0 オブジェクトライブラリは、xlfr50.olb になります。
- Macintosh: アプリケーション名言語コード [バージョン] OLB。次に例を示します。
- French Visual Basic for Applications の Version 2 のオブジェクトライブラリは VA FR 2 OLB になります。
- French Microsoft Excel 5.0 オブジェクトライブラリは、MS Excel FR 50 OLB になります。
- 使用するプロジェクトやライブラリが自分のシステムで見つからない場合は参照元プロジェクトの作成者に問い合わせてください｡
- 使用するライブラリが Microsoft アプリケーションオブジェクトライブラリである場合は、次の方法で入手できます。
- ※参照元プロジェクト現在のプロジェクト｡プロジェクトへのリンクの作成方法は､ホストアプリケーションによって異なります｡
- たとえば、Microsoft Excel のプロジェクトを直接参照するには、[ツール] メニューの [参照設定] をクリックして [参照設定] ダイアログボックスを表示し、参照するプロジェクトを選択します｡
- 直接参照先プロジェクトで Public として宣言した変数は、直接参照元プロジェクトから参照できます。
- ただし、直接参照元プロジェクトで Public として宣言した変数は、直接参照先プロジェクトからは参照できません。
詳細については、目的の項目を選択して F1 キー (Windows) または Help キー (Macintosh) を押してください。

コピー Copy・PasteSpecialメソッドVBA

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

VBA

VBA
Copy メソッド
PasteSpecial メソッド
PasteSpecial メソッド (Range オブジェクト)
- 構文
- PasteSpecial メソッド (Range オブジェクト) の使用例
PasteSpecial メソッド (Worksheet オブジェクト)

Copy メソッド

構文 1 では
、コントロールまたは描画オブジェクトをクリップボードにコピーします。また、グラフのデータ要素またはデータ系列のピクチャをクリップボードにコピーします。
構文 2 では
、Range オブジェクトを指定したセル範囲へ、またはクリップボードへコピーします。
構文 3 では
、シートをブック内の他の場所にコピーします。
構文 1
expression.Copy
構文 2
expression.Copy(Destination)
構文 3
expression.Copy(Before, After)
expression
必ず指定します。対象となるオブジェクトへの参照を表すオブジェクト式を指定します。グラフシート全体をコピーするときは、構文 3 で対象となる Chart オブジェクトを指定します。グラフエリアだけをコピーするときは、構文 1 で対象となる ChartArea オブジェクトを指定します。
Destination
省略可能です。バリアント型 (Variant) の値を使用します。コピー先のセル範囲を指定します。この引数を省略すると、クリップボードへコピーされます。
Before
省略可能です。バリアント型 (Variant) の値を使用します。コピーしたシートを特定のシートの直前の位置に挿入するときに、そのシートを指定します。ただし、引数 Before を指定すると、引数 After を指定することはできません。
After
省略可能です。バリアント型 (Variant) の値を使用します。コピーしたシートを特定のシートの直後の位置に挿入するときに、そのシートを指定します。ただし、引数 After を指定すると、引数 Before を指定することはできません。
解説
引数 Before と引数 After の両方を省略した場合は、新規ブックが自動的に作成され、シートはそのブック内にコピーされます。
Copy メソッドの使用例
次の使用例は、シート 1 のコピーを、シート 3 の後に挿入します。
Worksheets("Sheet1").Copy after := Worksheets("Sheet3")
次の使用例は、シート 1 で使われたセル範囲をコピーし、新しくワークシートを作成して、そのワークシートにコピーしたセル範囲の値を貼り付けます。

Worksheets("Sheet1").UsedRange.Copy
Set newSheet = Worksheets.Add
newSheet.Range("A1").PasteSpecial Paste:=xlValues
次の使用例は、シート 1 のセル範囲 A1:D4 をシート 2 のセル範囲 E5:H8 にコピーします。

Worksheets("Sheet1").Range("A1:D4").Copy _
destination:=Worksheets("Sheet2").Range("E5")

PasteSpecial メソッド

Range オブジェクトの場合

指定された範囲にクリップボードのデータを貼り付けます。

Worksheet オブジェクトの場合

指定された書式でクリップボードの内容をシートに貼り付けます。このメソッドは他のアプリケーションからデータを貼り付ける場合、または特別な形式でデータを貼り付ける場合に使います。

PasteSpecial メソッド (Range オブジェクト)

クリップボードのデータを、指定されたセル範囲に貼り付けます。

構文
expression.PasteSpecial(Paste, Operation, SkipBlanks, Transpose)
expression
必ず指定します。対象となる Range オブジェクトを表すオブジェクト式を指定します。
Paste
省略可能です。バリアント型 (Variant) の値を使用します。指定範囲に何を貼り付けるかを指定します。
使用できる定数は、XlPasteType クラス

xlPasteAll	全て	既定値
xlPasteFormulas	式
xlPasteValues	値
xlPasteFormats	書式
xlPasteComments	コメント
xlPasteAllExceptBorders	入力規則

Operation
省略可能です。バリアント型 (Variant) の値を使用します。貼り付けの方法を指定します。
使用できる定数は、XlPasteSpecialOperation クラス

xlPasteSpecialOperationNone	しない	既定値
xlPasteSpecialOperationAdd	加算
xlPasteSpecialOperationSubtract	減算
xlPasteSpecialOperationMultiply	乗算
xlPasteSpecialOperationDivide	除算

SkipBlanks
省略可能です。バリアント型 (Variant) の値を使用します。クリップボードに含まれる空白のセルを貼り付けの対象にしないようにするには、True を指定します。既定値は False です。
Transpose
省略可能です。バリアント型 (Variant) の値を使用します。指定すると、貼り付けのときにデータの行と列を入れ替えるには、True を指定します。既定値は False です。
PasteSpecial メソッド (Range オブジェクト) の使用例
次の使用例は、シート 1 のセル範囲 D1:D5 の各セルのデータに、シート 1 のセル範囲 C1:C5 の対応するセルのデータを加算します。

With Worksheets("Sheet1")
.Range("C1:C5").Copy
.Range("D1:D5").PasteSpecial _
Operation:=xlPasteSpecialOperationAdd
End With

PasteSpecial メソッド (Worksheet オブジェクト)

指定された形式で、クリップボードの内容をシートに貼り付けます。他のアプリケーションからデータを貼り付けるときや、あるいは特別な形式でデータを貼り付ける場合に使います。

構文
expression.PasteSpecial(Format, Link, DisplayAsIcon, IconFileName, IconIndex, IconLabel)
expression
必ず指定します。対象となる DialogSheet オブジェクト、または Worksheet オブジェクトを表すオブジェクト式を指定します。
Format
省略可能です。バリアント型 (Variant) の値を使用します。クリップボードのデータの形式を文字列で指定します。
Link
省略可能です。バリアント型 (Variant) の値を使用します。元のデータと貼り付けたデータの間にリンクを設定するには、True を指定します。元のデータがリンクに適さないデータである場合や、元のデータを作成したアプリケーションがリンクをサポートしない場合には、この引数は無視されます。既定値は False です。
DisplayAsIcon
省略可能です。バリアント型 (Variant) の値を使用します。貼り付けたデータはアイコンとして表示するには、True を指定します。既定値は False です。
IconFileName
省略可能です。バリアント型 (Variant) の値を使用します。使われるアイコンの含まれているファイルを指定するには、引数 DisplayAsIcon に True を指定します。
IconIndex
省略可能です。バリアント型 (Variant) の値を使用します。アイコンファイルのどのアイコンを使うかを示すインデックス番号を指定します。
IconLabel
省略可能です。バリアント型 (Variant) の値を使用します。アイコンのラベルを文字列で指定します。
解説
このメソッドを使う前に、貼り付け先のセル範囲を必ず選択してください。
このメソッドは、クリップボードの内容に合うように現在の選択範囲を変更します。
PasteSpecial メソッド (Worksheet オブジェクト) の使用例
次の使用例は、クリップボードの Word 文書のオブジェクトを、シート 1 のセル D1 に貼り付けます。
Worksheets("Sheet1").Range("D1").Select
ActiveSheet.PasteSpecial Format:="Microsoft Word 文書オブジェクト"
次の使用例は、クリップボードの Word 文書のオブジェクトを、シート 1 のセル F5 に貼り付け、それをアイコンとして表示します。

Worksheets("Sheet1").Range("F5").Select
ActiveSheet.PasteSpecial _
Format:="Microsoft Word 8.0 文書オブジェクト", _
DisplayAsIcon:=True

コピークリップボードにデータを格納する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'************************************************
'クリップボードにデータを格納する
'************************************************

    'DataObjectオブジェクト(MSFormsメンバ)
    'Microsoft Forms 2.0 Object Library参照設定。
    '※ブックにUserFormを挿入すると自動参照設定される

Function クリップボード格納(Str As String) As String

    Dim clipboard As DataObject
    Dim GetStr As String

    GetStr = Str

    Set clipboard = New DataObject 'DataObjectインスタンス

    clipboard.SetText GetStr 'Set
    clipboard.PutInClipboard '格納

End Function

Function クリップボード取得() As String
    Dim DtObj As New DataObject
    With DtObj
        .GetFromClipboard   'DataObjectに取得
        クリップボード取得 = .GetText 'DataObjectを変数取得
    End With
End Function

Private Sub test()
クリップボード格納 ("ほにゃらら")
MsgBox クリップボード取得
End Sub

コピープロセス間通信クリップボードの関数一覧-1

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

一覧
ChangeClipboardChain
- クリップボードビューアのチェインから、指定されたウィンドウを削除します。
CloseClipboard
- クリップボードを閉じます。
CountClipboardFormats
- 現在クリップボード内に存在するデータが持つデータ形式の数を取得します。
EmptyClipboard
- クリップボードを空にし、クリップボード内のデータのハンドルを解放します。同時に、クリップボードを開いたウィンドウに、クリップボードの所有権を与えます。
EnumClipboardFormats
- 現在クリップボード内に存在するデータが持つデータ形式を列挙します。
GetClipboardData
- クリップボードから、指定された形式のデータを取得します。

一覧

関数	説明
ChangeClipboardChain	クリップボードビューアのチェインから、指定されたウィンドウを削除します。
CloseClipboard	クリップボードを閉じます。
CountClipboardFormats	現在クリップボード内に存在するデータが持つデータ形式の数を取得します。
EmptyClipboard	クリップボードを空にし、クリップボード内のデータのハンドルを解放します。
EnumClipboardFormats	現在クリップボード内に存在するデータが持つデータ形式を列挙します。
GetClipboardData	クリップボードから、指定された形式のデータを取得します。
GetClipboardFormatName	クリップボードから、指定された登録済みデータ形式の名前を取得します。
GetClipboardOwner	現在クリップボードを所有しているウィンドウのハンドルを取得します。
GetClipboardSequenceNumber	現在のウィンドウステーションのクリップボードのシーケンス番号を取得します。
GetClipboardViewer	クリップボードビューアのチェイン内にある最初のウィンドウのハンドルを取得します。
GetOpenClipboardWindow	現在クリップボードを開いているウィンドウのハンドルを取得します。
GetPriorityClipboardFormat	指定されたリストの中から、最初に利用できるクリップボードデータ形式を返します。
IsClipboardFormatAvailable	指定されたデータ形式のデータがクリップボードに格納されているかどうかを調べます。
OpenClipboard	検討の目的でクリップボードを開き、他のアプリケーションがクリップボードの内容を変更できないようにします。
RegisterClipboardFormat	クリップボードの新しいデータ形式を Windows システムに登録します。
SetClipboardData	クリップボードに、指定されたデータ形式でデータを格納します。
SetClipboardViewer	クリップボードビューアのチェインに、指定されたウィンドウを追加します。

ChangeClipboardChain

クリップボードビューアのチェインから、指定されたウィンドウを削除します。

BOOL ChangeClipboardChain(
HWND hWndRemove, // 削除したいウィンドウのハンドル
HWND hWndNewNext // 次のウィンドウのハンドル
);

パラメータ
hWndRemove
［入力］クリップボードビューアのチェインから削除したいウィンドウのハンドルを指定します。以前に SetClipboardViewer 関数に渡したハンドルでなければなりません。
hWndNewNext
［入力］クリップボードビューアのチェイン内で hWndRemove ウィンドウの次に存在するウィンドウのハンドルを指定します。このハンドルは、SetClipboardViewer 関数の戻り値です。ただし、メッセージによりクリップボードビューアのチェインが変更された場合は、その限りではありません。クリップボードビューアのチェインが変更されるとこのメッセージが送信されるので、このメッセージを監視して、常に次のウィンドウを把握してください。
戻り値
クリップボードビューアチェイン内のウィンドウに WM_CHANGECBCHAIN メッセージを渡した結果を示す値が返ります。クリップボードビューアチェイン内のウィンドウは、WM_CHANGECBCHAIN メッセージを処理すると、一般的には、0（FALSE）を返します。そのため、ChangeClipboardChain 関数の戻り値は、一般的には、0（FALSE）になります。クリップボードビューアチェイン内に、ウィンドウが 1 つしかなかったときの戻り値は、一般的に、0 以外の値（TRUE）になります。
解説
クリップボードビューアチェイン内の hWndRemove ウィンドウの位置には、代わりに、hWndNewNext ウィンドウが置かれます。SetClipboardViewer 関数は、クリップボードビューアチェイン内の最初のウィンドウに、WM_CHANGECBCHAIN メッセージを送信します。

CloseClipboard

クリップボードを閉じます。

BOOL CloseClipboard(VOID);

パラメータ
パラメータはありません。
戻り値
関数が成功すると、0 以外の値が返ります。
関数が失敗すると、0 が返ります。拡張エラー情報を取得するには、関数を使います。
解説
クリップボードの参照または変更が終了したら、CloseClipboard 関数を呼び出してクリップボードを閉じてください。この結果、他のアプリケーションがクリップボードにアクセスできるようになります。
CloseClipboard を呼び出した後は、クリップボードにオブジェクトを配置しないでください。

CountClipboardFormats

現在クリップボード内に存在するデータが持つデータ形式の数を取得します。

int CountClipboardFormats(VOID);

パラメータ
パラメータはありません。
戻り値
関数が成功すると、現在クリップボード内に存在するデータが持つデータ形式の数が返ります。
関数が失敗すると、0 が返ります。拡張エラー情報を取得するには、関数を使います。

EmptyClipboard

クリップボードを空にし、クリップボード内のデータのハンドルを解放します。同時に、クリップボードを開いたウィンドウに、クリップボードの所有権を与えます。

BOOL EmptyClipboard(VOID);

パラメータ
パラメータはありません。
戻り値
関数が成功すると、0 以外の値が返ります。
関数が失敗すると、0 が返ります。拡張エラー情報を取得するには、関数を使います。
解説
EmptyClipboard 関数を呼び出す前に、OpenClipboard 関数でクリップボードを開いておく必要があります。NULL のウィンドウハンドルを指定してクリップボードを開いていた場合、EmptyClipboard 関数は成功しますが、クリップボードのオーナーは NULL になります。

EnumClipboardFormats

現在クリップボード内に存在するデータが持つデータ形式を列挙します。

クリップボードのデータは、順序付きリスト内に格納されています。クリップボードのデータ形式を列挙するには、EnumClipboardFormats 関数を繰り返し呼び出します。このとき、format パラメータはクリップボードで利用可能なデータ形式を示し、この関数は、クリップボードで次に利用可能なデータ形式を返します。

UINT EnumClipboardFormats(
UINT format // クリップボードで利用可能なデータ形式
);
パラメータ
format
［入力］クリップボードで利用可能であることがわかっているデータ形式を指定します。
データ形式の列挙を開始するときは、0 を指定します。0 を指定すると、最初に利用可能なデータ形式が返されます。以後、戻り値を次回の呼び出し時の引数にしながら繰り返し EnumClipboardFormats 関数を呼び出すことで、データ形式を列挙できます。
戻り値
関数が成功すると、指定したデータ形式に続くデータ形式が返ります。言い換えると、クリップボードで次に利用可能なデータ形式が返ります。
関数が失敗すると、0 が返ります。拡張エラー情報を取得するには、関数を使います。クリップボードが開いていない場合は、関数は失敗します。
列挙するクリップボードのデータ形式がそれ以上ない場合、戻り値は 0 になります。このとき、GetLastError 関数は NO_ERROR 値を返します。この値を調べることで、関数の失敗と列挙の終わりを区別できます。
解説
クリップボードのデータ形式を列挙する前に、クリップボードを開いておかなければなりません。クリップボードを開くには、OpenClipboard 関数を使います。クリップボードが開いていない場合、EnumClipboardFormats 関数は失敗します。
クリップボードのデータ形式は、クリップボードに格納された順番で列挙されます。情報をクリップボードへコピーする際に、最も記述的なデータ形式を最初に、最も記述量の少ないデータ形式を最後に追加してください。クリップボードのデータを貼り付ける際に、処理できる最初のデータ形式を取得してください。この結果、処理できるデータ形式のうち、最も記述的なものを取得できます。
クリップボードの特定のデータ形式に関して、システムは自動的な型変換機能を提供します。そのようなデータ形式に関連して、この関数は最初に、指定されたデータ形式を列挙し、次に変換可能な変換済みデータ形式を列挙します。詳細については、「」と「」を参照してください。

GetClipboardData

クリップボードから、指定された形式のデータを取得します。

クリップボードは、あらかじめ開いておく必要があります。

HANDLE GetClipboardData(
UINT uFormat // クリップボードのデータ形式
);

パラメータ
uFormat
［入力］クリップボードのデータ形式を指定します。詳細については、「」を参照してください。
戻り値
関数が成功すると、指定したデータ形式のクリップボードオブジェクトのハンドルが返ります。
関数が失敗すると、NULL が返ります。拡張エラー情報を取得するには、関数を使います。
解説
EnumClipboardFormats 関数を使うと、利用可能なデータ形式をあらかじめ列挙できます。
GetClipboardData 関数が返すハンドルは、アプリケーションではなくクリップボードが管理しています。アプリケーションはデータを即座にコピーするべきです。また、アプリケーションはハンドルを解放することや、ロックし続けることを避けなければなりません。さらにアプリケーションは、EmptyClipboard または CloseClipboard を呼び出した後にハンドルを使うことや、SetClipboardData を呼び出した後にクリップボードの同じデータ形式を指定することを避けなければなりません。
アプリケーションが GetClipboardData 関数を呼び出したとき、オペレーティングシステムがデータ形式の暗黙的な変換を行います。たとえば、CF_OEMTEXT のデータがクリップボードにある場合、アプリケーションはそのデータを CF_TEXT 形式のデータとして取り出すこともできます。クリップボード内のデータ形式は、必要に応じて、要求されたデータ形式へ変換されます。詳細については、「」を参照してください。

フォルダ指定ファイル群をフォルダからフォルダへコピー

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FileCopyFolderToFolder(ExtensionName As String, _
                            tgtPath As String, OutPath As String)
'***********************************************
'指定ファイル群をフォルダからフォルダへコピー
'***********************************************
'【引数】
'ExtensionName 対象ファイル拡張子等例"*.htm*"
'tgtPath 元フォルダ、コピー元フルパス
'OutPath 先フォルダ、コピー先フルパス

'移動先に同じ名前のファイルが存在する場合は削除
'手段は他にもあります。

Dim buf As String

    buf = Dir(tgtPath & "\" & ExtensionName)
    Do Until buf = Empty
        'FileCopyの場合は同名ファイルでもコピー(上書き)します。
        FileCopy tgtPath & "\" & buf, OutPath & "\" & buf
        buf = Dir()
    Loop
End Sub

フォルダ今いるパスからフォルダ名だけを取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Function OnlyFolderName(strPath As String) As String
'***************************************
'今いるパスからフォルダ名だけを取得する
'***************************************
Dim spl As Variant, st As Variant
st = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
'st = Split(strPath, "\")
'st = st(UBound(st))
OnlyFolderName = st
End Function

Private Sub test()
MsgBox OnlyFolderName(ThisWorkbook.Path)
End Sub

フォルダ今いるパスの一つ前までのパス取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function OneOfPath(strNowPath As String) As String
'*********************************
'今いるパスの一つ前までのパス取得
'*********************************
On Error GoTo theerr:
Dim OneFolPath As String
OneFolPath = Left(strNowPath, InStrRev(strNowPath, "\") - 1)
OneOfPath = OneFolPath
Exit Function
theerr:
OneOfPath = ""
'--------------
'InStrRev 関数
'--------------
'ある文字列の中から指定された文字列を最後の文字位置から検索を開始し、
'最初に見つかった文字位置を返す関数。
'構文
'InstrRev(検索先文字, 検索する文字, 開始位置, 比較モード)
'InstrRev(~~~必須~~~, ~~~~必須~~~~, ~~略可~~, ~~~略可~~~)
'開始位置を省略すると -1 が使用され、最後の文字位置から検索を開始
'比較モードを省略すると、バイナリモードで比較
'比較モード設定値
'定数値説明
'vbUseCompareOption -[-1]- Option Compare ステートメントの設定。
'vbBinaryCompare -----[0]- バイナリモードで比較を行います。
'vbTextCompare -------[1]- テキストモードで比較を行います。
'VbDatabaseCompare ---[2]- Microsoft Access の場合のみ有効。
End Function

Private Sub test()
MsgBox OneOfPath(ThisWorkbook.Path)
End Sub

フォルダ異なるフォルダからファイルを読み該当値を置き換え新ファイルを作成する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ByRefByValSubFunction()
'**********************************************************************
'異なるフォルダからファイルを読み該当値を置き換え新ファイルを作成する
'**********************************************************************
'《値の受け渡し》ByRefとByValの使い別け
'《値の受け渡し》SubとFunctionの比較
'動作：フォルダＡテキストをフォルダＢファイルのフォーマットにして変換
'変換したファイルをフォルダＣへHTML形式にして作成

Dim strThePath As String
Dim strTheTxtPath As String
Dim AddFilePath As String
Dim Strsend As String
Dim FileName() As String
Dim TXt(20) As String, cntFile As Long, Basictxt(6) As String
Dim AddTxt As String, temporaryTXT As String, cntBasictxt As Long
Dim SearchLetter As String, FolName As String
Dim strFileName() As String
Dim i As Long, lngMin As Long, lngMax As Long
Dim n As Long, buf As Variant, tmp As String
Dim j As Long, strTXT() As String, cntLowTXT As Long

'パラメータ
'フォルダ名
FolName = "index"
'置換するファイルパス
strThePath = ThisWorkbook.Path & "\" & FolName & "\"
'検索するファイルパス
strTheTxtPath = ThisWorkbook.Path & "\" & FolName & "Basic\"
'作成するファイルパス
AddFilePath = ThisWorkbook.Path & "\www\xxxx\"
'検索するファイル番号
cntBasictxt = 5
'検索する文字列
SearchLetter = "vbvalue0"
'置換するファイル読み込み最高行
cntLowTXT = 10
'**************************************************
'【置換するファイル】

'ByRefとByValで値の受け渡しをしています。
Call FileNameEnumeration(strFileName, strThePath)

'受け取った変数の最低値と最高値を取得
lngMin = LBound(strFileName)
lngMax = UBound(strFileName)

'各ファイル名を変数格納
ReDim FileName(lngMax) As String
ReDim strTXT(lngMax, cntLowTXT) As String

For i = lngMin To lngMax

    n = FreeFile
    Open strThePath & strFileName(i) For Input As #n
        FileName(i) = Mid(strFileName(i), 1, InStrRev(strFileName(i), ".") - 1)
        j = 0
        Do Until EOF(1) 'EOF 関数
            Line Input #n, tmp
            '各ファイルを行毎に変数格納
            strTXT(i, j) = tmp
            j = j + 1
        Loop
    Close #n

Next i

'EOF 関数
'ランダムアクセスモード (Random) またはシーケンシャル入力モード (Input) で
'開いたファイルの現在位置がファイルの末尾に達している場合、
'ブール型 (Boolean) の値の真 (True) を含む整数型 (Integer) の値を返します。

'**************************************************
'【検索するファイル】

For i = 1 To cntBasictxt
    Basictxt(i) = Read_Basic(strTheTxtPath, CByte(i))
Next i

For cntFile = lngMin To lngMax
    AddTxt = ""
    temporaryTXT = ""
        temporaryTXT = Basictxt(1)

        temporaryTXT = Replace(temporaryTXT, SearchLetter & "1", FolName)
        temporaryTXT = Replace(temporaryTXT, SearchLetter & "2", strTXT(cntFile, 0))

        For n = 1 To UBound(strTXT, 2)
            If Left(strTXT(cntFile, n), 1) = 1 Then
                temporaryTXT = temporaryTXT & Replace(Basictxt(2), SearchLetter & "3", strTXT(cntFile, n))
            ElseIf Left(strTXT(cntFile, n), 1) = 2 Then
                temporaryTXT = temporaryTXT & Replace(Basictxt(3), SearchLetter & "4", strTXT(cntFile, n))
            ElseIf Left(strTXT(cntFile, n), 1) = 3 Then
                temporaryTXT = temporaryTXT & Replace(Basictxt(4), SearchLetter & "5", strTXT(cntFile, n))
            End If
        Next n

        AddTxt = temporaryTXT & Basictxt(5)

'生成
TXT_Write AddFilePath & FileName(cntFile) & ".html", AddTxt

Next cntFile
End Sub

Private Function Read_Basic(TxtPath As String, strNo As Byte) As String
'*******************************************************************************
'ファイルを読みこむ
'*******************************************************************************
    Dim n As Long, buf As String, strPath As String
    strPath = TxtPath & strNo & ".txt"
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    buf = Space(FileLen(strPath))
    Open strPath For Binary As #n 'binaryモードで開いたファイル
        Get #n, , buf
    Close #n
    Read_Basic = buf
End Function

Private Sub FileNameEnumeration(ByRef strFileName() As String, ByVal strPath As String)
'***********************************************
'指定フォルダ内のファイル名一覧を取得列挙する。
'***********************************************
'呼び出される側
'可変変数

'Dim strPth As String
Dim buf As String, i As Long
Dim strExtension As String

'strPath = strThePath
strExtension = "txt" '拡張子
i = 0

    buf = Dir(strPath & "\*." & strExtension)
    Do While buf <> ""
    ReDim Preserve strFileName(i) As String
        strFileName(i) = buf
        i = i + 1
        buf = Dir()
    Loop

End Sub

Private Sub TXT_Write(FileName As String, str As String)
'*******************************************************************************
'指定パスのテキストファイルに書き込み
'*******************************************************************************
    Dim n As Long
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    Open FileName For Output As #n
        Print #n, str
    Close #n

' キーワード処理             モード
' Input   読み込み           入力モード
' Output  書き込み           出力モード
' Append  書き込み           追加モード
' Random  読み込み/書き込み  ランダムアクセスモード(データベースのデータファイルにアクセスするモード)
' Binary  読み込み/書き込み  バイナリモード(ファイルのデータを一気に読み込む)

End Sub

フォルダフォルダ内の別のブックを開く

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub FileOpen(TargetBookName As String, PathBookName As String)

''引数 TargetBookName ターゲットブック名例？？？.xls
''引数 PathBookName パスを取得するブック名例？？？.xls

'’＊ブックを開く
'’＊同じフォルダ内の別のブックを開く
'’＊開いた後のセットは別途必要
''Aiei LTD

'’画面更新無効
Application.ScreenUpdating = False
'’変数の定義
Dim TargetBook

    ''error発生の場合次へ・・
    On Error Resume Next
    ''該当Ｂｏｏｋをセット
    Set TargetBook = Workbooks(TargetBookName)
    '’error発生の場合無効
    On Error GoTo 0
    '’既に開かれていた場合
    If IsObject(TargetBook) Then
        '’保存なしにて閉じる
        Workbooks(TargetBookName).Close SaveChanges:=False
    End If
    '’セット終了
    Set TargetBook = Nothing
    '’パスの定義
    Dim PathBook As String
    '’パスの取得
    PathBook = Workbooks(PathBookName).Path
    '’ターゲットブックを変更可にてオープン
    With Workbooks
        .Open Filename:=PathBook & "\" & TargetBookName, ReadOnly:=False
    End With

End Sub

フォルダ一つ上のフォルダ名を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Function GetOneHierarchyFolder() As String
'***************************************
'一つ上のフォルダ名を取得する
'***************************************
'※エラー等は空白を返る
Dim BkPth As String, i As Long, Strtmp As String
BkPth = ThisWorkbook.Path
    For i = Len(BkPth) To 0 Step -1
        If InStr(i, BkPth, "\") > 0 Then
            Strtmp = Mid(BkPth, InStr(i, BkPth, "\") + 1)
            Exit For
        End If
    Next
    GetOneHierarchyFolder = Strtmp
End Function

Private Sub test()
MsgBox GetOneHierarchyFolder
End Sub

フォルダフォルダを検索、無い場合作成

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub BKUFolder()
'**************************************
'目的のフォルダを検索、無い場合作成する
'**************************************
'有った場合、そのフォルダ内にある元からあるファイルを削除する。
'バックアップ用

Dim strFl_mn As String
Dim dirFile As String

'パラメータ
'フォルダ名(パスも含む)
strFl_mn = ThisWorkbook.Path & "\TEST"

'無い場合目的フォルダを作成
If Dir$(strFl_mn, vbDirectory) = "" Then
    MkDir strFl_mn
    Exit Sub
Else 'ある場合
    'ファイルが存在するか確認
    dirFile = Dir(strFl_mn & "\*.*", 0)
    'ファイルが存在する場合
    If dirFile <> "" Then
        Kill strFl_mn & "\*.*"
    End If
    '既存のフォルダを削除する場合の処理
    'dirFile = Dir()
    'RmDir strFl_mn
End If

'------------------------------------------------------------------------
'【構文】
'Dir[(pathname[, attributes])]

'pathname   省略可能。
'   ファイル名を表す文字列式を指定｡
'   フォルダ名およびドライブ名も含めて指定できます｡
'   引数 pathname に指定した内容が見つからないときは、長さ 0 の文字列 (" ") を返します。
'Attributes 省略可能。
'   取得するファイルが持つ属性の値の合計を表す数式または定数を指定します｡
'   省略すると､標準ファイルの属性になります｡

'vbNormal       0 標準ファイル
'vbReadOnly     1 読み取り専用ファイル
'vbHidden       2 隠しファイル
'vbSystem       4 システムファイル。Macintosh不可。
'vbVolume       8 ボリュームラベル。すべての属性無効。Macintosh不可。
'vbDirectory   16 フォルダ
'vbAlias       64 エイリアスファイル。Macintoshのみ。
'------------------------------------------------------------------------

End Sub

フォルダフォルダとファイルに関するキーワード一覧

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

'フォルダの変更 ChDir
'ドライブの変更 ChDrive
'ファイルのコピー FileCopy
'フォルダの作成 MkDir
'フォルダの削除 RmDir
'ファイルまたはフォルダの名前の変更 Name
'現在のパスの取得 CurDir
'ファイルの日付または時間のスタンプの取得 FileDateTime
'ファイルまたはラベルの属性の取得 GetAttr
'ファイルの長さの取得 FileLen
'ファイルの名前またはボリュームラベルの取得 Dir
'ファイルの属性情報の設定 SetAttr

フォルダファイルまたはフォルダDir関数

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Dir 関数

指定したパターンやファイル属性と一致するファイルまたはフォルダの名前を表す文字列型 (String) の値を返します。ドライブのボリュームラベルも取得できます。

構文
Dir[(pathname[, attributes])]
Dir 関数の構文は、次の指定項目から構成されます。
指定項目内容
pathname
省略可能です。ファイル名を表す文字列式を指定します。フォルダ名およびドライブ名も含めて指定できます。引数 pathname に指定した内容が見つからないときは、長さ 0 の文字列 (" ") を返します。
attributes
省略可能です。取得するファイルが持つ属性の値の合計を表す数式または定数を指定します。省略すると、標準ファイルの属性になります。
設定値
引数
attributes の設定値は次のとおりです。

定数	値	内容
vbNormal	0	標準ファイル
vbReadOnly	1	読み取り専用ファイル
vbHidden	2	隠しファイル
vbSystem	4	システムファイル。Macintosh では使用できません。
vbVolume	8	ボリュームラベル。この値を指定すると、すべての属性は無効になります。Macintosh では使用できません。
vbDirectory	16	フォルダ
vbAlias	64	エイリアスファイル。Macintosh でのみ使用できます。

メモ
これらの定数は、Visual Basic で定義されています。したがって、実際の数値の代わりにコードで使用することができます。
解説
Windows の場合
、複数のファイルを指定するための "*" (アスタリスク) および "?" (疑問符) のワイルドカード文字を使用できます。Macintosh の場合、これらの文字は有効なファイル名の文字として扱われるため、このワイルドカード文字を使用して複数ファイルを指定することはできません。
また、Macintosh で
ワイルドカード文字がサポートされていないため、ファイルの種類によって複数のファイルを識別することができません。特定の種類のファイルを指定するには、ファイル名を使用せずに MacID 関数を使用します。例えば、次の例では、最初に見つかった、タイプが TEXT のファイルを返します。
Dir("SomePath", MacID("TEXT"))
フォルダ内のすべてのファイルに対して繰り返して処理を実行
する場合は、引数を指定せずにDir を実行してください。
Dir("")
Windows で MacID 関数と Dir 関数を組み合わせて使用した場合
はエラーが発生します。
引数 attribute に
256 より大きな値を指定した場合は MacID 関数の値と見なされます。
Dir 関数を最初に呼び出すとき
、引数 pathname を指定しないとエラーになります。またファイル属性 (引数 attributes) を指定する場合にも、引数 pathname を指定する必要があります。
Dir 関数は、引数 pathname と
一致する最初のファイル名を返します。それ以外のファイル名で引数 pathname と一致するファイル名を取得するには、引数を指定せずに再び Dir 関数を呼び出してください。一致するファイル名がない場合は、Dir 関数は長さ 0 の文字列を返します。長さ 0 の文字列が返された場合は、次に Dir 関数を呼び出すときに引数 pathname を再び指定しなければなりません。指定しないとエラーが発生します。現在の引数 pathname と一致するファイル名をすべて取得していなくても、途中で引数 pathname の指定を変更できます。ただし、Dir 関数を再帰的に呼び出すことはできません。vbDirectory 属性を指定して Dir 関数を続けて呼び出しても、連続する下位レベルのサブフォルダは返しません。
ヒント
取得したファイルを整理する必要があるときには、ファイル名を配列に格納して並べ替え (ソート) を行ってください。

Dir 関数の使用例

次の例は、Dir 関数を使って、指定したファイルまたはフォルダがあるかどうかを確認します。Macintosh, の場合、既定のドライブ名は “HD:” で、パスの区切り文字には円記号 ("\") ではなくコロン (":") を使用してフォルダを指定します。また、ワイルドカード文字は、Mac のフォルダ指定では使用できませんが、MacID 関数を使用すると複数のファイルを指定することができます。

Option Explicit

Dim MyFile, MyPath, MyName
' "WIN.INI" が存在する場合、そのファイル名を返します(Microsoft Windows の場合)。
MyFile = Dir("C:\WINDOWS\WIN.INI")

' 指定した拡張子を持つファイル名を返します。複数の *.INI ファイル
' が存在すると、最初に見つかったファイル名を返します。
MyFile = Dir("C:\WINDOWS\*.INI")

' 引数を指定せずに再度 Dir 関数を呼び出すと、
' 同じフォルダにある次の *.INIファイルを返します。
MyFile = Dir

' 隠しファイル属性を持つ *.TXT ファイルであり、最初に見つかったファイル名を返します。
MyFile = Dir("*.TXT", vbHidden)

' C:\ 内のフォルダの名前を表示します。
MyPath = "c:\"    ' パスを設定します。
MyName = Dir(MyPath, vbDirectory)    ' 最初のフォルダ名を返します。
Do While MyName <> ""    ' ループを開始します。
    ' 現在のフォルダと親フォルダは無視します。
    If MyName <> "." And MyName <> ".." Then
        ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            Debug.Print MyName        ' フォルダであれば、それを表示します。
        End If
    End If
    MyName = Dir                    ' 次のフォルダ名を返します。
Loop

フォルダフォルダがない場合作成するエラー取得-MkDirステートメント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FolderMaking(strPath As String, FolderName As String) As Boolean
'****************************************
'フォルダ作成(エラー回避)
'****************************************

Dim strErr As String

On Error GoTo ErrEND:

    If Dir(strPath & "\" & FolderName, vbDirectory) = "" Then
        MkDir strPath & "\" & FolderName
        FolderMaking = True
    Else
        MsgBox FolderName & " は作成出来ません。", vbCritical, strPath
        FolderMaking = False
    End If
Exit Function

ErrEND:
strErr = Err.Description

'MsgBox strErr
Debug.Print strErr

FolderMaking = False

End Function

Private Sub test()
Dim a As String, b(20) As String, i As Byte
a = ThisWorkbook.Path

b(1) = "Test"
b(2) = "Test" '同名
b(3) = "Test\"      '使用不可文字
b(4) = "Test/"      '使用不可文字
b(5) = "Test:"      '使用不可文字
b(6) = "Test*"      '使用不可文字
b(7) = "Test?"      '使用不可文字
b(8) = "Test"""     '使用不可文字
b(9) = "Test<"      '使用不可文字
b(10) = "Test>"     '使用不可文字
b(11) = "Test|"     '使用不可文字
b(12) = "\Test"     '使用不可文字
b(13) = "/Test"     '使用不可文字
b(14) = ":Test"     '使用不可文字
b(15) = "*Test"     '使用不可文字
b(16) = "?Test"     '使用不可文字
b(17) = """Test"    '使用不可文字
b(18) = "<Test"     '使用不可文字
b(19) = ">Test"     '使用不可文字
b(20) = "|Test"     '使用不可文字

For i = 1 To 20
    If FolderMaking(a, b(i)) = True Then
        Debug.Print i & ":成功"
    Else
        Debug.Print i & ":失敗"
    End If
Next i

'1: 成功
'2: 失敗
'3: 失敗
'4: 失敗
'5: 失敗'ファイル名または番号が不正です｡
'6: 失敗
'7: 失敗
'8: 失敗
'9: 失敗
'10: 失敗
'11: 失敗'ファイル名または番号が不正です｡
'12: 失敗
'13: 失敗
'14: 失敗'ファイル名または番号が不正です｡
'15: 失敗
'16: 失敗'パスが見つかりません｡
'17: 失敗'パスが見つかりません｡
'18: 失敗
'19: 失敗'パスが見つかりません｡
'20: 失敗'ファイル名または番号が不正です｡

End Sub

MkDir ステートメント

新しいフォルダを作成します。

構文
MkDir path
引数 path
は必ず指定します。引数 path には、作成するフォルダ名を示す文字列式を指定します。ドライブ名も含めて指定できます。ドライブ名を省略したときは、現在のドライブに新しいフォルダが作成されます。

フォルダフォルダ内のファイル全てを一括移動

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub フォルダ名を変更()
'********************************************
'フォルダ名を変更する
'フォルダ内のファイル全てを一括移動
'********************************************
'解説：フォルダ内のファイル全て移動するにはファルダ名を変更すれば良い
'※特殊な事情は除く

Dim oldName(2) As String
Dim newName(2) As String
Dim strpath As String

strpath = ThisWorkbook.Path

'変換元←→変換先を入れ替えたことになる
oldName(1) = strpath & "\変換元"
newName(1) = strpath & "\k変換元" '[k]を付けただけだが同名注意
oldName(2) = strpath & "\変換先"
newName(2) = strpath & "\k変換先" '[k]を付けただけだが同名注意

Name oldName(1) As newName(1)
Name oldName(2) As newName(2)
Name newName(1) As oldName(2)
Name newName(2) As oldName(1)

End Sub

フォルダフォルダ存在確認-Dir関数-落とし穴(使用不可文字)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FolderExistence(strPath As String) As Boolean
'********************************************
'フォルダが存在しているかどうかを確認する
'********************************************
Dim strErr As String

On Error GoTo ErrEND:

    If Dir(strPath, vbDirectory) = "" Then
        FolderExistence = False
    Else
        FolderExistence = True
    End If
Exit Function

ErrEND:
strErr = Err.Description

'MsgBox strErr
Debug.Print strErr

FolderExistence = False

End Function

Private Sub test()
Dim a As String, b(20) As String, i As Byte
a = ThisWorkbook.Path

b(1) = "Test"   '予め作成済み
b(2) = "TestZ"  '不存在フォルダ
b(3) = "Test\"      '使用不可文字
b(4) = "Test/"      '使用不可文字
b(5) = "Test:"      '使用不可文字
b(6) = "Test*"      '使用不可文字
b(7) = "Test?"      '使用不可文字
b(8) = "Test"""     '使用不可文字
b(9) = "Test<"      '使用不可文字
b(10) = "Test>"     '使用不可文字
b(11) = "Test|"     '使用不可文字
b(12) = "\Test"     '使用不可文字
b(13) = "/Test"     '使用不可文字
b(14) = ":Test"     '使用不可文字
b(15) = "*Test"     '使用不可文字
b(16) = "?Test"     '使用不可文字
b(17) = """Test"    '使用不可文字
b(18) = "<Test"     '使用不可文字
b(19) = ">Test"     '使用不可文字
b(20) = "|Test"     '使用不可文字

For i = 1 To 20
    If FolderExistence(a & "\" & b(i)) = True Then
        Debug.Print i & ":存在"
    Else
        Debug.Print i & ":不存在"
    End If
Next i

'1: 存在
'2: 不存在
'3: 存在
'4: 存在
'5: 不存在'ファイル名または番号が不正です｡
'6: 存在
'7: 存在
'8: 存在
'9: 存在
'10: 存在
'11: 不存在'ファイル名または番号が不正です｡
'12: 存在
'13: 存在
'14: 不存在'ファイル名または番号が不正です｡
'15: 存在
'16: 不存在
'17: 不存在
'18: 存在
'19: 不存在
'20: 不存在'ファイル名または番号が不正です｡

End Sub

フォルダ使用不可文字を指定して確認すると「存在」とみなす文字もある

Dir 関数

指定したパターンやファイル属性と一致するファイルまたはフォルダの名前を表す文字列型 (String) の値を返します。ドライブのボリュームラベルも取得できます。

構文
Dir[(pathname[, attributes])]
Dir 関数の構文は、次の指定項目から構成されます。
指定項目内容
pathname
省略可能です。ファイル名を表す文字列式を指定します。フォルダ名およびドライブ名も含めて指定できます。引数 pathname に指定した内容が見つからないときは、長さ 0 の文字列 (" ") を返します。
attributes
省略可能です。取得するファイルが持つ属性の値の合計を表す数式または定数を指定します。省略すると、標準ファイルの属性になります。
設定値
引数 attributes の設定値は次のとおりです。

定数	値	内容
vbNormal	0	標準ファイル
vbReadOnly	1	読み取り専用ファイル
vbHidden	2	隠しファイル
vbSystem	4	システムファイル。Macintosh では使用できません。
vbVolume	8	ボリュームラベル。この値を指定すると、すべての属性は無効になります。Macintosh では使用できません。
vbDirectory	16	フォルダ
vbAlias	64	エイリアスファイル。Macintosh でのみ使用できます。

フォルダフォルダ内の全てのファイル移動(同名存在削除)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FolderInFileMove()
'***********************************************
'フォルダ内の全てのファイル移動(同名存在削除)
'***********************************************
'移動先に同じ名前のファイルが存在する場合は削除
'手段は他にもあります。

Dim buf As String
Dim tgtPath As String
Dim OutPath As String
Dim DefaultFolderName As String
Dim NewFolderName As String
Dim ExtensionName As String

ExtensionName = "htm*" '指定してください"

DefaultFolderName = "元フォルダ"  '移動元フォルダ名
NewFolderName = "先フォルダ"          '移動先フォルダ名

tgtPath = ThisWorkbook.Path & "\" & DefaultFolderName
OutPath = ThisWorkbook.Path & "\" & NewFolderName

    buf = Dir(tgtPath & "\*." & ExtensionName)
    Do Until buf = Empty
        'FileCopyの場合は同名ファイルでもコピー(上書き)します。
        FileCopy tgtPath & "\" & buf, OutPath & "\" & buf
        buf = Dir()
    Loop
    'ファイルの存在確認
    If Dir(tgtPath & "\*." & ExtensionName) <> "" Then
        '元のファイルを削除します
        Kill tgtPath & "\*." & ExtensionName
    End If
End Sub

Sub FolderInFileMove2()
'***********************************************
'フォルダ内の全てのファイル移動(同名存在削除)
'***********************************************
'移動先に同じ名前のファイルが存在する場合は削除
'手段は他にもあります。

Dim buf As String
Dim tgtPath As String
Dim OutPath As String
Dim DefaultFolderName As String
Dim NewFolderName As String
Dim ExtensionName As String

ExtensionName = "htm*" '指定してください"

DefaultFolderName = "元フォルダ"  '移動元フォルダ名
NewFolderName = "先フォルダ"          '移動先フォルダ名

tgtPath = ThisWorkbook.Path & "\" & DefaultFolderName
OutPath = ThisWorkbook.Path & "\" & NewFolderName

    buf = Dir(tgtPath & "\*." & ExtensionName)
    Do While buf <> ""
        'FileCopyの場合は同名ファイルでもコピー(上書き)します。
        FileCopy tgtPath & "\" & buf, OutPath & "\" & buf
        buf = Dir()
    Loop
    'ファイルの存在確認
    If Dir(tgtPath & "\*." & ExtensionName) <> "" Then
        '元のファイルを削除します
        Kill tgtPath & "\*." & ExtensionName
    End If

End Sub

ファイルファイルの拡張子名を取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FileExtensionName(strFileName As String) As String
'*****************************
'ファイルの拡張子名を取得
'*****************************
'[.]付きで返す

Dim i As Long

i = InStrRev(strFileName, ".")
'i = i + 1 '([.]無しで返す場合)
FileExtensionName = Mid(strFileName, i)

'-------------------------------------------------------------------------
'【構文】
'InstrRev(stringcheck, stringmatch[, start[, compare]])
'文字列から指定文字列を最後から検索し文字位置を返す

'stringcheck    必ず指定    検索先の文字列式を指定｡
'stringmatch    必ず指定    検索する文字列式を指定｡
'start          省略可能    各検索の開始位置を設定。
'compare        省略可能    文字列比較のモード指定。規定値バイナリモード
'
'引数compareの設定値
'
'定数値説明
'vbUseCompareOption    -1 Option Compare ステートメントの設定比較
'vbBinaryCompare        0 バイナリモード比較
'vbTextCompare          1 テキストモード比較
'VbDatabaseCompare      2 Microsoft Access の場合
'-------------------------------------------------------------------------
End Function

Function FileExtensionNameFso(strPath As String) As String
'*****************************
'ファイルの拡張子名を取得FSO
'*****************************
'[.]無しで返す

Dim objSFSO As Object
Set objSFSO = CreateObject("Scripting.FileSystemObject")

FileExtensionNameFso = objSFSO.GetExtensionName(strPath)

Set objSFSO = Nothing

End Function

Function FileNonExtensionNameFso(strPath As String)
'***********************************
'ファイル名だけ拡張子なしを取得FSO
'***********************************
'[.]無しで返す

Dim objSFSO
Set objSFSO = CreateObject("Scripting.FileSystemObject")

FileNonExtensionNameFso = objSFSO.GetBaseName(strPath)

Set objSFSO = Nothing

End Function

Private Sub test()
Dim strNm As String
Dim strPth As String

strNm = ThisWorkbook.Name
strPth = ThisWorkbook.Path & "\" & strNm

MsgBox FileExtensionName(strNm)

MsgBox FileExtensionNameFso(strPth)

MsgBox FileNonExtensionNameFso(strPth)

End Sub

ファイルファイルコピーFSO

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ファイルコピーFSO(コピー元 As String, コピー先 As String)
'******************************************
'FSOファイルコピー(パラメータ(引数)はフルパス)
'******************************************
'*[参照設定] で「Microsoft Scripting Runtime」にチェック
'*パラメータ(引数)[コピー元]には[*.txt]のように[*]を使用可能
'*パラメータ(引数)[コピー先]には最後に[\]が必須

Dim objFSO As FileSystemObject

Set objFSO = New FileSystemObject
objFSO.MoveFile コピー元, コピー先
Set objFSO = Nothing

End Sub

Sub ファイルコピー(コピー元 As String, コピー先 As String)
'******************************************
'ファイルコピー(パラメータ(引数)はフルパス)
'******************************************
FileCopy コピー元, コピー先

End Sub

Sub ファイル移動(移動元 As String, 移動先 As String)
'********************************************
'ファイルを移動(同一ドライブの場合)
'********************************************
Name 移動元 As 移動先
End Sub

ファイルファイルの一覧を取得する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub ファイルの一覧を取得する()
'*******************************************************************************
'ファイルの一覧を取得する
'*******************************************************************************
    Dim buf As String, i As Long
    buf = Dir("D:\*.*")
    Do While buf <> ""
        i = i + 1
        Worksheets("Sheet1").Cells(i, 1) = buf
        buf = Dir()
    Loop
End Sub

ファイルテキストファイルを大量作成(セルの文字)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Sub AutomaticCellsTxt()
'****************************************
'テキストファイルを大量作成(セルの文字)
'****************************************
'同じファイル名は上書きされます。
Dim TxtPath As String, str(5) As String
Dim StartNo As Long, EndNo As Long
Dim n As Long, i As Long
Dim FileName As String, strWrite As String
Dim sht As Worksheet

Set sht = ThisWorkbook.Worksheets("Sheet1")

TxtPath = ThisWorkbook.Path & "\"           '作成箇所
StartNo = 1                                 'スタート番号
EndNo = sht.Cells(65536, 1).End(xlUp).Row   '終了番号

With sht
For i = StartNo To EndNo
    n = FreeFile '使われていないファイル番号を自動的に割り振る
    str(1) = .Cells(i, 1).Value
    str(2) = .Cells(i, 2).Value
    str(3) = .Cells(i, 3).Value
    str(4) = .Cells(i, 4).Value
    str(5) = .Cells(i, 5).Value                     '拡張子
    strWrite = str(1) & str(2) & str(3) & str(4)    '記入内容
    FileName = TxtPath & strWrite & str(5)          'ファイル名
    Open FileName For Output As #n
        Print #n, strWrite
    Close #n
Next i
End With

' キーワード処理             モード
' Input   読み込み           入力モード
' Output  書き込み           出力モード
' Append  書き込み           追加モード
' Random  読み込み/書き込み  ランダムアクセスモード(データベースのデータファイルにアクセスするモード)
' Binary  読み込み/書き込み  バイナリモード(ファイルのデータを一気に読み込む)

End Sub

ファイル VBAファイル・フォルダ・ドライブを使用のより詳しい使い方のヒント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

VBAファイル・フォルダ・ドライブを使用のより詳しい使い方のヒント

VBAファイル・フォルダ・ドライブを使用のより詳しい使い方のヒント

利用可能なオプション
- VBA 関数
- Microsoft Scripting Runtime オブジェクトライブラリ
- Office FileSearch オブジェクト
- ファイルシステム関連の Windows API 関数
- この資料では、Windows API 関数についてだけは説明していません。
- Windows API 関数について独自に調査する場合は、FindFirstFile、FindNextFile、および FindClose 関数を参照してください。
VBA 関数を使用した作業
使用できる関数

関数	説明
Dir	指定したパターンまたはファイル属性に一致するファイル、ディレクトリ、またはフォルダの名前を返します。
GetAttr	ファイル、ディレクトリ、またはフォルダの属性を返します。
SetAttr	ファイル、ディレクトリ、またはフォルダの属性を指定します。
CurDir	カレントディレクトリを返します。
ChDir	カレントディレクトリを変更します。
ChDrive	現在のドライブを変更します。
MkDir	新しいディレクトリを作成します。
RmDir	既存のディレクトリを削除します。
Kill	1 つ以上のファイルを削除します。
FileLen	ディスク上のファイルの長さをバイト単位で返します。
LOF	開いているファイルの長さをバイト単位で返します。
FileCopy	ディスク上のファイルをコピーします。
FileDateTime	ファイルが作成された、または最後に変更された日付と時刻を返します。
Name	ファイルの名前を変更し、ディスク上の別の場所に移動します。
Open	ディスク上のファイルを読み取り用または書き込み用に開きます。
Input	開いているファイルから文字列を読み取ります。
Print	シーケンシャルファイルにテキストを書き込みます。
Write	シーケンシャルファイルにテキストを書き込みます。
Close	Open ステートメントを使用して開いたファイルを閉じます。

Dir 関数と GetAttr 関数について説明
ファイルが存在するかどうかを調べるために Dir 関数を使用する方法
Dir 関数は、 pathname 引数で指定したファイルの名前を返します。
一般的には、Dir 関数を使用して、以下の DoesFileExist 関数で示すように、指定したファイルが存在するかどうかを調べます。
サンプルコード

Option Explicit

Function DoesFileExist(strFileSpec As String) As Boolean
    ' strFilespec 引数で指定されたファイルが存在する
    ' 場合は True を返します。
    ' strFileSpec が有効なファイルではない場合、または
    ' strFileSpec がディレクトリの場合は False を返します。
    Const INVALID_ARGUMENT As Long = 53
    On Error GoTo DoesfileExist_Err
    If (GetAttr(strFileSpec) And vbDirectory) <> vbDirectory Then
        DoesFileExist = CBool(Len(Dir(strFileSpec)) > 0)
    Else
        DoesFileExist = False
    End If
DoesfileExist_End:
    Exit Function
DoesfileExist_Err:
    DoesFileExist = False
    Resume DoesfileExist_End
End Function

説明
この例では、GetAttr 関数を使用して、 strFileSpec 引数の値がディレクトリでないことを確認しています。
これは、有効なディレクトリ名を Dir 関数に渡すと、関数がそのディレクトリで最初に見つけたファイルを返すためです。
フォルダ内のすべてのファイル名を取得するために Dir 関数を使用する方法
pathname 引数が、フォルダ内のファイル名ではなく、フォルダへのパスを含んでいる場合、Dir 関数はそのフォルダで最初に見つけたファイルの名前を返します。
その後、引数を指定しないで再度 Dir 関数を呼び出すと、フォルダ内でその後に見つけた各ファイルの名前を順次取得します。
たとえば、以下のプロシージャは、 strDirPath 引数で指定されたディレクトリ内のすべてのファイル名を保持する配列を返します。
サンプルコード

Option Explicit

Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
    ' strDirPath で指定されたディレクトリをループしてすべて調べ、
    ' 配列に各ファイル名を保存します。その後、呼び出し側のプロ
    ' シージャにその配列を返します。
    ' strDirPath が有効なディレクトリではない場合は False を返します。
    Dim strTempName As String
    Dim varFiles() As Variant
    Dim lngFileCount As Long

    On Error GoTo GetAllFiles_Err

    ' strDirPath が "\" 文字で終わっていることを確認します。
    If Right$(strDirPath, 1) <> "\" Then
        strDirPath = strDirPath & "\"
    End If

    ' strDirPath がディレクトリであることを確認します。
    If (GetAttr(strFileSpec) And vbDirectory) = vbDirectory Then
        strTempName = Dir(strDirPath, vbDirectory)
        Do Until Len(strTempName) = 0
            ' "." と ".." を除外します。
            If (strTempName <> ".") And (strTempName <> "..") Then
                ' サブディレクトリ名がないことを確認します。
                If (GetAttr(strDirPath & strTempName) _
                    And vbDirectory) <> vbDirectory Then
                    ' 見つかったファイル名に応じて配列の
                    ' サイズを増加し、そのファイル名を配列
                    ' に追加します。
                    ReDim Preserve varFiles(lngFileCount)
                    varFiles(lngFileCount) = strTempName
                    lngFileCount = lngFileCount + 1
                End If
            End If
            ' Dir 関数を使用して、次のファイル名を検索します。
            strTempName = Dir()
        Loop
        ' 見つかったファイルの配列を返します。
        GetAllFilesInDir = varFiles
    End If
GetAllFiles_End:
    Exit Function
GetAllFiles_Err:
    GetAllFilesInDir = False
    Resume GetAllFiles_End
End Function

説明
GetAllFilesInDir 関数は、ディレクトリ内の各項目をループして作業し、その項目がファイルの場合は、ファイル名を配列に追加します。
最初に Dir を呼び出す場合は、引数にディレクトリ名を指定します。
その後の各呼び出しでは引数を指定しないで Dir を呼び出します。プロシージャは、GetAttr 関数を使用して、 strDirPath 引数が有効なディレクトリを保持しているか確認します。
また、配列にサブディレクトリ名が追加されるの防ぐためにも GetAttr 関数を使用しています。
さらに、プロシージャではカレントディレクトリと親ディレクトリを表す "." と ".." も配列に追加しないようにしていることに注意してください。
以下のプロシージャを使用して、
GetAllFilesInDir プロシージャをテストできます。
strDirName 引数に別の値を指定後、F8 キーを使用して、1 ステップずつコードを実行し、プロシージャがどのように機能しているかを確認できます。
サンプルコード

Option Explicit

Sub TestGetAllFiles()
    Dim varFileArray As Variant
    Dim lngI As Long
    Dim strDirName As String

    Const NO_FILES_IN_DIR As Long = 9
    Const INVALID_DIR As Long = 13

    On Error GoTo Test_Err

    strDirName = "c:\my documents"
    varFileArray = GetAllFilesInDir(strDirName)
    For lngI = 0 To UBound(varFileArray)
        Debug.Print varFileArray(lngI)
    Next lngI

Test_Err:
    Select Case Err.Number
        Case NO_FILES_IN_DIR
            MsgBox "The directory named '" & strDirName _
                & "' contains no files."
        Case INVALID_DIR
            MsgBox "'" & strDirName & "' is not a valid directory."
        Case 0
        Case Else
            MsgBox "Error #" & Err.Number & " - " & Err.Description
    End Select
End Sub

Microsoft Scripting Runtime オブジェクトライブラリを使用した作業
Microsoft Scripting Runtime オブジェクトライブラリは、Microsoft Office 2000 と共にインストールされ、ファイルやディレクトリを使った作業に使用できるオブジェクトを持っています。
ファイルやディレクトリにアクセスする場合、オブジェクトライブラリは、上記で説明した VBA 関数よりも容易に使用できます。
オブジェクトライブラリを使用する前に、このライブラリへの参照を設定する必要があります。
Microsoft Scripting Runtime が [プロジェクト] メニューの [参照設定] ダイアログボックスに表示されない場合は、Scrrun.dll というファイルを C:\Windows\System サブフォルダから検索する必要があります。
Scripting Runtime ライブラリに含まれるオブジェクトを説明

オブジェクト	コレクション	説明
Dictionary		トップレベルオブジェクト。VBA Collection オブジェクトと同じものです。
Drive	Drives	システム上のドライブまたはドライブのコレクションのことです。
File	Files	ファイルシステム内のファイルまたはファイルのコレクションのことです。
FileSystemObject		トップレベルオブジェクト。ファイルシステム内のドライブ、フォルダ、およびファイルへのアクセスに使用します。
Folder	Folders	ファイルシステム内のフォルダまたはフォルダのコレクションのことです。
TextStream		テキストファイルとの間で、読み取り、書き込み、または追加を行うテキストのストリームのことです。

説明
Scripting Runtime オブジェクトライブラリのトップレベルオブジェクトは、Dictionary オブジェクトと FileSystemObject オブジェクトです。
Dictionary オブジェクトを使用するには、Dictionary 型のオブジェクト変数を作成します。
その後、Dictionary オブジェクトの新規インスタンスを設定します。

Option Explicit

Dim dctDict As Scripting.Dictionary

Set dctDict = New Scripting.Dictionary

コードでその他の Scripting Runtime ライブラリオブジェクトを使用するには、以下のコード例で示すように、最初に FileSystemObject 型の変数を作成し、New キーワードを使用して、FileSystemObject の新規インスタンスを作成します。

Option Explicit

Dim fsoSysObj As Scripting.FileSystemObject

Set fsoSysObj = New Scripting.FileSystemObject

その後、FileSystemObject を参照する変数を使用して、Drive、Folder、File、および TextStream オブジェクトを使った作業が可能になります。
FileSystemObject を使用してファイルやフォルダで作業する方法
FileSystemObject の新規インスタンス作成後に、これを使用してファイルシステム内のドライブ、フォルダ、およびファイルを使って作業できます。
以下のプロシージャは、Dictionary オブジェクトに特定のフォルダ内のファイルを返します。
GetFiles プロシージャには 3 つの引数があります。
最初の引数はディレクトリへのパス、2 番目の引数は Dictionary オブジェクトです。
3 番目の引数は省略可能な Boolean 型の引数で、このプロシージャが再帰的に呼び出されるかどうかを指定します。
プロシージャは、プロシージャが正常終了したかどうかを示す Boolean 値を返します。
プロシージャは、最初に Folder オブジェクトを返す GetFolder メソッドを使用します。
その後、そのフォルダの Files コレクション全体をループして各ファイルのパスとファイル名を Dictionary オブジェクトに追加します。
blnRecursive 引数が True に設定されている場合は、GetFiles プロシージャは各サブフォルダ内のファイルを返すために再帰的に呼び出されます。
サンプルコード

Option Explicit

Function GetFiles(strPath As String, _
                dctDict As Scripting.Dictionary, _
                Optional blnRecursive As Boolean) As Boolean

   ' このプロシージャは、ディレクトリ内のすべてのファイルを
   ' Dictionary オブジェクトに返します。再帰的に呼び出
   ' される場合は、サブフォルダ内のファイルもすべて返します。

   Dim fsoSysObj      As Scripting.FileSystemObject
   Dim fdrFolder      As Scripting.Folder
   Dim fdrSubFolder   As Scripting.Folder
   Dim filFile        As Scripting.File

   ' 新しい FileSystemObject を返します。
   Set fsoSysObj = New Scripting.FileSystemObject

   On Error Resume Next
   ' フォルダを取得します。
   Set fdrFolder = fsoSysObj.GetFolder(strPath)
   If Err <> 0 Then
      ' パスが間違っています。
      GetFiles = False
      GoTo GetFiles_End
   End If
   On Error GoTo 0

   ' Files コレクションをループし、Dictionary に追加します。
   For Each filFile In fdrFolder.Files
      dctDict.Add filFile.Path, filFile.Path
   Next filFile

   ' 再帰フラグが真の場合、再帰的に呼び出します。
   If blnRecursive Then
      For Each fdrSubFolder In fdrFolder.SubFolders
         GetFiles fdrSubFolder.Path, dctDict, True
      Next fdrSubFolder
   End If

   ' エラーが発生しなかった場合は、True を返します。
   GetFiles = True

GetFiles_End:
   Exit Function
End Function

以下のプロシージャを使用して、
GetFiles プロシージャをテストできます。
このプロシージャは、新規 Dictionary オブジェクトを作成し、作成したオブジェクトを GetFiles プロシージャに渡します。
その後、strDirPath ディレクトリとそのサブディレクトリ内のすべてのファイルをイミディエイトウィンドウに出力します。
サンプルコード

Option Explicit

Sub TestGetFiles()
   ' GetFiles 関数をテストするために呼び出します。

   Dim dctDict As Scripting.Dictionary
   Dim varItem As Variant
   Dim strDirPath As String

   strDirPath = "c:\my documents\"
   ' 新規 Dictionary を作成します。
   Set dctDict = New Scripting.Dictionary
   ' 再帰的に呼び出し、Dictionary オブジェクトにファイルを返します。
   If GetFiles(strDirPath, dctDict, True) Then
      ' Dictionary 内の項目を出力します。
      For Each varItem In dctDict
         Debug.Print varItem
      Next
   End If
End Sub

説明
strDirPath 引数に別の値を指定して、このプロシージャが別のディレクトリを使用してどのように機能するかを調べることができます。
FileSystemObject を使用し、ファイル属性を用いて作業する方法
以下の例で示すように、File オブジェクトと Folder オブジェクトは、ファイルやフォルダの属性を設定または取得できる Attributes プロパティを提供します。
ChangeFileAttributes プロシージャには 4 つの引数があります。
1. 最初の引数はフォルダへのパスです。
2. 2 番目の引数は省略可能で、設定する属性を指定する定数です。
3. 3 番目の引数も省略可能で、削除する属性を指定する定数です。
4. 4 番目の引数も省略可能で、プロシージャが再帰的に呼び出されるかどうかを指定します。
渡されたフォルダへのパスが有効な場合、プロシージャは Folder オブジェクトを返します。
次に lngSetAttr 引数が指定されているかどうかを調べます。
指定されている場合は、プロシージャはフォルダ内のすべてのファイルをループして、新しい属性を既存の属性に追加します。続いて、 lngRemoveAttr 引数に対しても同様の処理を行います。
ただし、この場合はコレクション内にファイルが存在するときに指定した属性を削除します。
最後に、プロシージャは blnRecursive 引数が True に設定されているかどうかを調べます。
設定されている場合は、 strPath 引数の各サブフォルダ内のファイルごとにプロシージャを呼び出します。
サンプルコード

Option Explicit

Function ChangeFileAttributes(strPath As String, _
                            Optional lngSetAttr As FileAttribute, _
                            Optional lngRemoveAttr As FileAttribute, _
                            Optional blnRecursive As Boolean) As Boolean

   ' この関数は、ディレクトリパス、設定するファイル属性を示す値、
   ' 削除するファイル属性を示す値、および再帰的に呼び出される
   ' かどうかを示すフラグを引数として受け取ります。
   ' エラーが発生しなかった場合は True を返します。

   Dim fsoSysObj      As Scripting.FileSystemObject
   Dim fdrFolder      As Scripting.Folder
   Dim fdrSubFolder   As Scripting.Folder
   Dim filFile        As Scripting.File

   ' 新規 FileSystemObject を返します。
   Set fsoSysObj = New Scripting.FileSystemObject

   On Error Resume Next
   ' フォルダを取得します。
   Set fdrFolder = fsoSysObj.GetFolder(strPath)
   If Err <> 0 Then
      ' パスが間違っています。
      ChangeFileAttributes = False
      GoTo ChangeFileAttributes_End
   End If
   On Error GoTo 0

   ' 呼び出し側が設定する属性を渡した場合は、すべてに対して設定します。
   If lngSetAttr Then
      For Each filFile In fdrFolder.Files
         If Not (filFile.Attributes And lngSetAttr) Then
            filFile.Attributes = filFile.Attributes Or lngSetAttr
         End If
      Next
   End If

   ' 呼び出し側が削除する属性を渡した場合は、すべてに対して削除します。
   If lngRemoveAttr Then
      For Each filFile In fdrFolder.Files
         If (filFile.Attributes And lngRemoveAttr) Then
            filFile.Attributes = filFile.Attributes - lngRemoveAttr
         End If
      Next
   End If

   ' 呼び出し側が blnRecursive 引数に True を設定した場合は、
   ' 関数を再帰的に呼び出します。
   If blnRecursive Then
      ' サブフォルダをループします。
      For Each fdrSubFolder In fdrFolder.SubFolders
         ' サブフォルダのパスを指定して関数を呼び出します。
         ChangeFileAttributes fdrSubFolder.Path, lngSetAttr, _
            lngRemoveAttr, True
      Next
   End If
   ChangeFileAttributes = True

ChangeFileAttributes_End:
   Exit Function
End Function

以下のプロシージャを使用して、
ChangeFileAttributes プロシージャをテストできます。
この例では、My Documents フォルダのすべてのファイルの隠しファイル属性を可視に設定します。
サンプルコード

Option Explicit

Sub TestChangeAttributes()
    If ChangeFileAttributes("c:\my documents", , _
        Hidden, False) = True Then
        MsgBox "File attributes succesfully changed!"
    End If
End Sub

ChangefileAttributes の引数に別の値を指定して、プロシージャがどのように機能するかを調べることができます。
FileSearch オブジェクトを使用した作業
FileSearch オブジェクトは、Microsoft Office 9.0 Object Library のメンバです。
このライブラリは、Office の [ファイルを開く] ダイアログボックスのすべての機能に対するプログラムインターフェイスを公開します。
公開されるインターフェイスには、[ファイルを開く] ダイアログボックスから利用できる [高度な検索] ダイアログボックスが持つ機能も含まれます。
FileSearch オブジェクトのオブジェクト、メソッド、およびプロパティを使用して、指定した条件に基づいて、ファイルやファイルのコレクションを検索できます。
以下の例は、FileSearch オブジェクトを使用して、 strFilespec 引数で指定された種類のファイルを 1 つ以上検索する方法を示しています。
セミコロンで区切られた拡張子のリストを指定することにより、複数のファイル拡張子を検索できるところに注目してください。
サンプルコード

Option Explicit

Function CustomFindFile(strFileSpec As String)
    ' このプロシージャは、"c:\" ディレクトリ内で strFileSpec
    ' 引数で指定されるファイル指定に一致するすべてのファ
    ' イルの名前を持つメッセージボックスを表示する簡単な
    ' ファイル検索ルーチンを示しています。
    ' strFileSpec 引数は、セミコロンで区切られたリストを使
    ' 用して、1 つ以上のファイル指定を含むことができます。
    ' たとえば、strFileSpec 引数に "*.log;*.bat;*.ini" を指
    ' 定すると、 "c:\" 内でこれらの拡張子を持つファイルが
    ' すべて返されます。

    Dim fsoFileSearch   As Office.FileSearch
    Dim varFile         As Variant
    Dim strFileList     As String

    ' 入力が有効な場合に、ファイル検索を行います。
    If Len(strFileSpec) >= 3 And InStr(strFileSpec, "*.") > 0 Then
        Set fsoFileSearch = Application.FileSearch
        With fsoFileSearch
            .NewSearch
            .LookIn = "c:\"
            .Filename = strFileSpec
            .SearchSubFolders = False
            If .Execute() > 0 Then
                For Each varFile In .FoundFiles
                    strFileList = strFileList & varFile & vbCrLf
                Next varFile
            End If
        End With
        MsgBox strFileList
    Else
        MsgBox strFileSpec & " is not a valid file specification."
        Exit Function
    End If
End Function

説明
FileSearch オブジェクトは 2 つのメソッドといくつかのプロパティを持っています。
これらを使用して、独自の Office ソリューションに独自のファイル検索機能を構築できます。
上記の例では、NewSearch メソッドを使用して以前の検索条件を消去し、Execute メソッドを使用して指定したファイルの検索を行います。
Execute メソッドは、見つかったファイル数を返します。
このメソッドは並べ替え順、並べ替えの方法、および検索の実行に保存した Find Fast インデックスだけを使用するかどうかなど、省略可能なパラメータもサポートします。
検索で見つかったすべての一致するファイルの名前を持つ FoundFiles オブジェクトへの参照を返すには、FoundFiles プロパティを使用します。
LookIn プロパティを使用して、検索するディレクトリを指定します。
さらに、LookIn プロパティで指定したディレクトリのサブディレクトリも検索するかどうかを指定するために SearchSubFolders プロパティを使用します。
FileName プロパティは、ワイルドカード文字や、複数のファイル名またはファイルの種類を指定するセミコロンで区切られたリストもサポートします。

ファイルドライブフォルダファイル関連一式

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub Test0()

Dim MyFile, MyPath, MyName
' "WIN.INI" が存在する場合、そのファイル名を返します(Microsoft Windows の場合)。
MyFile = Dir("C:\WINDOWS\WIN.INI")

' 指定した拡張子を持つファイル名を返します。複数の *.INI ファイル
' が存在すると、最初に見つかったファイル名を返します。
MyFile = Dir("C:\WINDOWS\*.INI")

' 引数を指定せずに再度 Dir 関数を呼び出すと、
' 同じフォルダにある次の *.INIファイルを返します。
MyFile = Dir

' 隠しファイル属性を持つ *.TXT ファイルであり、最初に見つかったファイル名を返します。
MyFile = Dir("*.TXT", vbHidden)

' C:\ 内のフォルダの名前を表示します。
MyPath = "c:"    ' パスを設定します。
MyName = Dir(MyPath, vbDirectory)    ' 最初のフォルダ名を返します。
Do While MyName <> ""    ' ループを開始します。
    ' 現在のフォルダと親フォルダは無視します。
    If MyName <> "." And MyName <> ".." Then
        ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            Debug.Print MyName        ' フォルダであれば、それを表示します。
        End If
    End If
    MyName = Dir                    ' 次のフォルダ名を返します。
Loop

End Sub

Sub Test1()
'CurDir[(drive)]
'引数 drive は省略可能です。引数 drive には、ドライブを示す文字列式を指定します。
'引数 drive を省略した場合、または長さ 0 の文字列 (" ") を指定した場合は、
'現在のドライブのパスを返します。

Dim MyPath As Variant
    '指定したドライブの現在のパスの値を返します
    MyPath = CurDir()

MsgBox MyPath

End Sub

Sub test2()
'ChDrive drive
'引数 drive は必ず指定します。
'引数 drive には、ドライブを示す文字列式を指定します。
'引数 drive に長さ 0 の文字列 (" ") を指定したときは、
'現在のドライブは変更されません。
'引数 drive に 2 文字以上の文字列を指定した場合、
'最初の 1 文字だけが使用されます。

    '現在のドライブを変更
    ChDrive "D"

Dim MyPath As Variant
    '指定したドライブの現在のパスの値を返します
    MyPath = CurDir()

MsgBox MyPath


End Sub

Sub Test3()
'ChDir Path
'引数 path は必ず指定します。
'引数 path には、新しく設定するフォルダを表す文字列式を指定します。
'引数 path には、既定のドライブ名が含まれています。
'ドライブ名を省略してフォルダを指定すると、
'ChDir ステートメントは現在のフォルダを現在のドライブの該当するフォルダに変更します。
'ChDir ステートメントを使用すると、フォルダを変更できます。
'ただし、ドライブは変更されません。
'たとえば、現在のドライブが C のとき、
'次に示すステートメントは、D ドライブのフォルダを変更しますが、
'現在のドライブは C のまま変更されません。

ChDir "D:\移動先"

Dim MyPath As Variant
    '指定したドライブの現在のパスの値を返します
    MyPath = CurDir()

MsgBox MyPath

End Sub

Sub Test4()
'ユーザーからファイル名を取得するために、[ファイルを開く] ダイアログボックスを
'表示します。ダイアログボックスで指定したファイルは、実際には開かれません。
'expression.GetOpenFilename(◆FileFilter, ◆FilterIndex, ◆Title, ◆ButtonText, ◆MultiSelect)
'expression   必ず指定します。
'対象となる Application オブジェクトを表すオブジェクト式を指定します。

'◆FileFilter   省略可能です。
'バリアント型 (Variant) の値を使用します。
'開くファイルの種類を指定する文字列 (ファイルフィルタ文字列) を指定します。

'ファイルフィルタ文字列とワイルドカードのペアを、必要な数だけ指定します。
'ファイルフィルタ文字列とワイルドカードはカンマ (,) で区切り、
'各ペアもカンマで区切って指定します。
'各ペアは、[ファイルの種類] ボックスのリストに表示されます。
'次にテキストファイルとアドインの 2 つのファイルフィルタを指定します。
'"テキストファイル (*.txt),*.txt,アドインファイル (*.xla),*.xla"
'1 つのファイルフィルタ文字列に複数のワイルドカードを対応させるには、
'次のように各ワイルドカードをセミコロン (;) で区切ります。
'"Visual Basic ファイル (*.bas; *.txt),*.bas;*.txt"
'この引数を省略すると "すべてのファイル (*.*),*.*" を指定したことになります。

'◆FilterIndex   省略可能です。
'バリアント型 (Variant) の値を使用します。
'引数 FileFilter で指定したファイルフィルタ文字列の中で、
'最初の 1 から何番目を既定値とするかを指定します。
'この引数を省略するか、引数 FileFilter に含まれる
'ファイルフィルタ文字列の数より大きい数値を指定すると、
'最初のファイルフィルタ文字列が既定値となります。

'◆Title   省略可能です。
'バリアント型 (Variant) の値を使用します。
'ダイアログボックスのタイトルを指定します。
'この引数を省略すると "ファイルを開く" になります。

'◆ButtonText   省略可能です。
'バリアント型 (Variant) の値を使用します。Macintosh のみ指定できます。

'◆MultiSelect   省略可能です。
'バリアント型 (Variant) の値を使用します。
'True を指定すると、複数のファイルを選択できます。
'False を指定すると、1 つのファイルしか選択できません。既定値は False です。

'GetOpenFilename メソッドは、ユーザーによって選択、
'または入力したファイルの名前とパス名を返します。
'引数 MultiSelect が True の場合は、
'選択したファイルの名前の配列が返されます。
'選択されたファイルが 1 つでも、配列として返されます。
'入力が取り消された場合には False が返されます。

'このメソッドを実行することによってカレントドライブや
'現在のフォルダが変更される可能性があります｡

Dim x As Variant
    x = Application.GetOpenFilename '("すべてのファイル(*.*), *.*")

    MsgBox x


End Sub

ファイルファイルが存在しているかどうかを確認する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Public Function FileExistence(FilePath As String) As Boolean
'**************************************************
'ファイルが存在しているかどうかを確認する
'**************************************************
    If Dir(FilePath) <> "" Then
        FileExistence = True
    Else
        FileExistence = False
    End If

End Function

Public Function FileExistenceFSO(FilePath As String) As Boolean
'**************************************************
'ファイルが存在しているかどうかを確認する(FSO)
'**************************************************

    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(FilePath) Then
            FileExistenceFSO = True
        Else
            FileExistenceFSO = False
        End If
    End With

End Function

Private Sub test()
Dim i As String
i = ThisWorkbook.Path & "\"
Debug.Print FileExistence(i & "*.xls")
Debug.Print FileExistence(i & "test.xls")
Debug.Print FileExistence(i)
Debug.Print FileExistence("test.xls")
Debug.Print FileExistence("xls")

'True
'False
'True
'False
'False
End Sub

ファイルファイルを移動削除

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub ファイルを移動削除()
'*******************************************************************************
'ファイルを移動削除
'*******************************************************************************
Dim 移動元ファイル As String, 移動先ファイル As String

移動元ファイル = "C:\TEST1\A.txt"
移動先ファイル = "C:\TEST2\A.txt"

    'ファイルコピー
    FileCopy 移動元ファイル, 移動先ファイル
    'ファイル削除
    Kill 移動元ファイル
End Sub

ファイルファイルをオープン

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Workbooks.Open Filename:=パス & "\" & "○○.xls", ReadOnly:=False

ファイルファイルを移動(同一ドライブの場合)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ファイル移動(移動元 As String, 移動先 As String)
'********************************************
'ファイルを移動(同一ドライブの場合)
'********************************************
Name 移動元 As 移動先
End Sub

ファイルファイル削除

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FSOを使用しファイルを削除()
'*********************************
'FSOを使用しファイルを削除
'*********************************
Dim objFSO As Object, DelPath As String, DelFile As String
DelPath = ThisWorkbook.Path
DelFile = "DEL1.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
objFSO.DeleteFile DelPath & "\" & DelFile
On Error GoTo 0
Set objFSO = Nothing
End Sub


Sub Killを使用しファイルを削除()
'*********************************
'Killを使用しファイルを削除
'*********************************
Dim DelPath As String, DelFile As String
DelPath = ThisWorkbook.Path
DelFile = "DEL2.txt"
On Error Resume Next
Kill DelPath & "\" & DelFile
On Error GoTo 0
End Sub

Sub ファイルを削除(パス As String, ファイル名 As String)
'**************************************
'ファイルを削除　引数指定
'パスの最後に[\]を付けない
'**************************************
On Error Resume Next
Kill パス & "\" & ファイル名
On Error GoTo 0
End Sub

ファイルファイル検索関連

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'●FileSearch オブジェクト

Sub NO1()

'次の使用例は、指定されたファイルを検索し、
'見つかったファイルの総数と、各ファイルのファイル名を表示します。

With Application.FileSearch
    If .Execute() > 0 Then '■①.Execute
        MsgBox .FoundFiles.Count & _
            " 個のファイルが見つかりました。" '■②.FoundFiles
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

'解説

'■①.Execute・・Execute メソッド (FileSearch オブジェクト)

'FileSearch オブジェクトでは､指定したファイルの検索を開始します｡

'構文

'expression.Execute(SortBy, SortOrder, AlwaysAccurate)

'expression       必ず指定します。FileSearch オブジェクトを表すオブジェクト式を指定します。

'SortBy           省略可能です。バリアント型 (Variant) の値を指定します。
'                 検索結果のファイルを並べ替えるときの基準を指定します。
'                 使用できる定数は、MsoSortBy クラスの msoSortbyFileName (ファイル名)、
'                 msoSortbyFileType (ファイルの種類)、 msoSortbyLastModified (更新日時)、
'                 msoSortbySize (サイズ) のいずれかです。

'SortOrder        省略可能です。バリアント型 (Variant) の値を指定します。
'                 検索結果のファイル一覧を並べ替えるときの順序を指定します。
'                 使用できる定数は、MsoSortOrder クラスの msoSortOrderAscending (昇順)
'                 または msoSortOrderDescending (降順) です。

'AlwaysAccurate   省略可能です。ブール型 (Boolean) の値を指定します。
'                 True を指定すると、ファイル一覧が最後に更新されてから追加、変更、
'                 または削除されたファイルも検索の対象に含まれます。既定値は True です。

'使用例

'次の使用例は、[My Documents] フォルダの中で、ファイル名の拡張子が ".doc" のファイルを
'すべて検索し、条件を満たすファイルの名前と保存場所の一覧を表示します。
'また、検索結果のファイル一覧を、ファイル名の昇順で並べ替えます。

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents" '■③.LookIn
    .FileName = "*.doc" '■④.Filename
    If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox .FoundFiles.Count & _
            " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

'■②.FoundFiles・・FoundFiles プロパティの使用例

'次の使用例は､ファイル検索で見つかったファイルの一覧をチェックし､各ファイルのパスを表示します｡

With Application.FileSearch
For i = 1 To .FoundFiles.Count
    MsgBox .FoundFiles(i)
Next i
End With

'■③.LookIn・・・LookIn プロパティの使用例

'次の使用例は、[My Documents] フォルダの中で、ファイル名が "cmd" で
'始まるすべてのファイルを検索し、条件を満たすファイルの名前と保存場所の一覧を表示します。

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .FileName = "cmd*.*"
    If .Execute > 0 Then
        MsgBox .FoundFiles.Count & _
        " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

'■④.Filename・・・FileName プロパティの使用例

'次の使用例は、[My Documents] フォルダに保存されている "cmd" で始まり、
'拡張子が付いているすべてのファイルを検索し、名前と保存場所を表示します。

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .FileName = "cmd*.*"
    If .Execute > 0 Then
        MsgBox .FoundFiles.Count & " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "ファイルは見つかりませんでした。"
    End If
End With

'次の使用例は､検索条件を既定の設定にリセットした後､新しい検索を開始します｡

With Application.FileSearch
    .NewSearch '■⑤NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True '■⑥.SearchSubFolders
    .FileName = "Run"
    .MatchTextExactly = True '■⑦.MatchTextExactly
    .FileType = msoFileTypeAllFiles '■⑧.FileType
End With

'■⑤NewSearch・・・NewSearch メソッド

'すべての検索条件を既定の設定にリセットします｡

'構文

'expression.NewSearch

'expression   必ず指定します。FileSearch オブジェクトを表すオブジェクト式を指定します。

'解説

'検索条件の設定は､アプリケーションを終了するまで保持されます｡このメソッドを使用すると､検索条件を変更するたびに不要な条件を削除する必要がありません｡なお､このメソッドを実行しても､LookIn プロパティの値はリセットされません｡

'使用例

'次の使用例は､NewSearch メソッドを使用して検索条件を既定の設定にリセットした後
'､新しい検索を開始します｡

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .FileName = "run"
    .TextOrProperty = "San*"
    .MatchAllWordForms = True
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
        MsgBox .FoundFiles.Count & _
        " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

'■⑥.SearchSubFolders・・・SearchSubFolders プロパティの使用例

'次の使用例は、[My Documents] フォルダの中で、ファイル名が
'"cmd" で始まるすべてのファイルを検索し、
'条件を満たすファイルの名前と保存場所の一覧を表示します。
'この使用例では、[My Documents] フォルダのサブフォルダもすべて検索の対象に含まれます。

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .FileName = "cmd*"
    If .Execute() > 0 Then
        MsgBox .FoundFiles.Count & _
         " 個のファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "検索条件を満たすファイルはありません。"
    End If
End With

'■⑦.MatchTextExactly・・・MatchTextExactly プロパティの使用例

'次の使用例は、[My Documents] フォルダの中で、ファイルの内容またはプロパティに "Run"
'という単語が含まれるすべてのファイルを返します。

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .TextOrProperty = "Run"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
End With

'■⑧.FileType・・・FileType プロパティの使用例

'次の使用例は、[My Documents] フォルダに含まれるすべてのバインダーファイルを検索し、
'見つかったファイルの名前と保存場所の一覧をメッセージボックスに表示します。

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .FileType = msoFileTypeBinders
    If .Execute > 0 Then
        MsgBox .FoundFiles.Count & _
            " 個のバインダーファイルが見つかりました。"
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i)
        Next i
    Else
        MsgBox "バインダーファイルは見つかりませんでした。"
    End If
End With

'■LastModified プロパティの使用例

'次の使用例は、ファイル検索のオプションを設定します。
'C:\My Documents フォルダに保存されているファイルの中で、
'昨日更新されたものを検索します。
'また、C:\My Documents フォルダのサブフォルダも検索の対象に含めます。

Set fs = Application.FileSearch
With fs
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .LastModified = msoLastModifiedYesterday
End With

'■MatchAllWordForms プロパティの使用例

'次の使用例は、ファイルの内容またはファイルプロパティに、
'"run"、"running"、"runs"、"ran" のいずれかの単語が含まれるファイルの一覧を返します。
'TextOrProperty プロパティは、検索する単語を設定し、
'検索の対象をファイルの内容またはファイルプロパティのいずれかに限定します。

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .TextOrProperty = "run"
    .MatchAllWordForms = True
    .FileType = msoFileTypeAllFiles
End With

'■PropertyTests プロパティの使用例

'次の使用例は､コレクションに含まれる先頭のプロパティ条件の内容を表示します｡

With Application.FileSearch.PropertyTests(1)
myString = "次の条件でファイルを検索します。" _
    & "プロパティ名 : " & .Name & " 。条件 : " _
    & .Condition & " 。"
If .Value <> "" Then
    myString = myString & "値 : " & .Value & " 。"
    If .SecondValue <> "" Then
        myString = myString _
            & " 2 番目の値 (上限) : " _
            & .SecondValue & " 。結合子 : " _
            & .Connector & " 。"
    End If
End If
MsgBox myString
End With

'■TextOrProperty プロパティの使用例

'次の使用例は、C:\My Documents フォルダとそのすべてのサブフォルダの中で、
'ファイルの内容またはプロパティのいずれかに "San" で始まる単語が含まれる
'すべてのファイルを検索します。TextOrProperty プロパティは、
'検索する単語を設定し、検索の対象をファイルの内容またはファイル
'プロパティのいずれかに限定します。

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .TextOrProperty = "San*"
    .FileType = msoFileTypeAllFiles
End With

End Sub

フォルダパスからファイル名やフォルダ名を返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fncFileName(strPath As String) As String
'*******************************************************************************
'パスからファイル名やフォルダ名を返す
'*******************************************************************************
fncFileName = Dir(strPath)
End Function

ブックブックを全て閉じるCloseメソッドの使用例

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'次の使用例は､Book1.xls のブックを閉じます｡内容の変更は保存しません｡

Workbooks("BOOK1.XLS").Close SaveChanges:=False

'次の使用例は､開かれているすべてのブックを閉じます｡
'開かれているブックの内容が変更されている場合は､確認のメッセージや､
'変更を保存するためのダイアログボックスが表示されます｡

Workbooks.Close

ブックブックに変更があるか判断する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function SavedAlerts(bok As Workbook)
'*********************************
'ブックに変更があるか判断する
'*********************************
'Saved プロパティ
' True の場合、ブックは最後の保存した状態から変更が加えられていません。
If bok.Saved = False Then
    If MsgBox("保存しますか？", vbYesNo, bok.Name) = vbYes Then
        '上書きを無視する(アラート非表示)
        Application.DisplayAlerts = False
        bok.Close SaveChanges:=True, Filename:="C:\規定パス\" & "規定名.xls"
        Application.DisplayAlerts = True 'アラート表示-元に戻す
    Else
        '何か処理があれば
        bok.Close
    End If
Else
    '何か処理があれば
End If

'Saved プロパティに True を設定して、変更を保存せずにブックを閉じます。
'bok.Saved = True
'bok.Close

End Function

ブックブックの保存

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & strName, FileFormat:=xlText

ブックコード実行中のブック以外のブックを保存なしで閉じる

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub psbコード実行中のブック以外のブックを閉じる()
'*******************************************************************************
'コード実行中のブック以外のブックを保存なしで閉じる
'*******************************************************************************
    Dim 要素

    For Each 要素 In Workbooks                  '各ワークブックに対して反復処理する
        If 要素.Name <> ThisWorkbook.Name Then  'コード実行中のブック名と違うなら
            要素.Close savechanges:=False       '保存しないで閉じる
        End If
    Next

End Sub

フォントフォント総てをシートに書き出す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub UseFont()
'****************************************
'フォント総てをシートに書き出す
'****************************************
'対象：PC内にインストールされているフォント
'抽出先：ActiveWorkbook.ActiveSheet
'2009/6/18更新
'プログラムが使用可能なフォントは 256 個という制限があります。
'[このブックで、これ以上新しいフォントは設定できません。]

Dim objcombo As CommandBarComboBox
Dim strFontName As String
Dim intFor As Integer
Dim sht As Worksheet
Dim lngThisRow As Long
Dim Mystr As String

Mystr = "Test"

Set sht = ActiveWorkbook.ActiveSheet
Set objcombo = CommandBars(4).Controls(1)

Application.ScreenUpdating = False

With sht
    .Range("a1:c65536").Clear '①
    .Range("a1").Value = "FontName" '②
End With

For intFor = 1 To objcombo.ListCount
    strFontName = objcombo.List(intFor)
        With sht
            lngThisRow = .Range("a1").CurrentRegion.Rows.Count + 1 '③
            .Range("a" & lngThisRow).Value = strFontName '④
            .Range("c" & lngThisRow).Value = Mystr '⑤
            If intFor <= 253 Then '⑦
                With .Range("c" & lngThisRow).Font '⑥
                    .Name = strFontName
                    .Size = 18
                End With
            End If
        End With
Next intFor

Application.ScreenUpdating = True

Set sht = Nothing
Set objcombo = Nothing

'以下でも可能
'.Range(.Cells(1, 1), .Cells(65536, 3)).Clear '①
'.Cells(1, 1).Value = "FontName" '②
'lngThisRow = .Cells().End(xlUp).Row + 1 '③
'.Cells(lngThisRow, 1).Value = strFontName '④
'.Cells(lngThisRow, 2).Value = Mystr '⑤
'With .Cells(lngThisRow, 3).Font '⑥
'⑦エクセル自体が使用するフォント数もあるため
End Sub

ブックシート新ブック保存

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Public Function fncシート新ブック保存(TagetBook As Workbook, TagetSheet As Worksheet, FolPath As String, ファイル名 As String) As String
'*******************************************************************************
'指定シートを新しいブックに保存（指定フォルダへ）必ずシート名は[Sheet1]にする
'保存後そのパスとファイル名を返す
'*******************************************************************************
Dim NewBook As Workbook, strName As String, NewSheet As Worksheet

strName = 保存名作成

Set NewBook = Workbooks.Add
    Dim i, cnt As Integer
    cnt = NewBook.Sheets.Count
    For i = 1 To cnt
        If NewBook.Sheets(i).Name = "Sheet1" Then
            NewBook.Sheets(i).Name = "Sheet0"
            Exit For
        End If
    Next

    TagetSheet.Copy Before:=NewBook.Sheets(1)
Set NewSheet = NewBook.Sheets(1)
    NewSheet.Name = "Sheet1"
    Call シート削除(NewBook, "Sheet0")
    NewBook.SaveAs Filename:= _
        FolPath & "\" & ファイル名 & "_" & strName & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    NewBook.Close
Set NewSheet = Nothing
Set NewBook = Nothing
fncシート新ブック保存 = FolPath & "\" & ファイル名 & "_" & strName & ".xls"
End Function

フォルダ指定フォルダ内の指定拡張子ファイルの指定順ファイル名取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function FolderExtensionFilesCount(FolderPath As String, Extension As String) As Long
'************************************************
'指定フォルダ内の指定拡張子ファイルの数をカウント
'************************************************

Dim buf As String, i As Long

buf = Dir(FolderPath & "\*." & Extension)
    Do While buf <> ""
        i = i + 1
        buf = Dir()
    Loop

FolderExtensionFilesCount = i

End Function

Private Sub test()
Dim FolderPath As String, Extension As String
FolderPath = ThisWorkbook.Path
Extension = "jpg"
Debug.Print FolderExtensionFilesCount(FolderPath, Extension)
' 4
End Sub

フォルダ指定フォルダ内のファイルの一覧を取得列挙する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub ファイル列挙(tgtPath As String)
'***********************************************
'指定フォルダ内のファイルの一覧を取得列挙する。
'拡張子指定可能
'***********************************************
'引数：tgtPath には取得列挙するフォルダフルパスを指定

Dim buf As String, i As Long, sht As Worksheet
Dim 拡張子指定 As String

拡張子指定 = "jpg" '指定してください
'指定しない場合は-------------------
'拡張子指定 = "*"
'-----------------------------------

Set sht = ThisWorkbook.Worksheets.Add

    buf = Dir(tgtPath & "\*." & 拡張子指定)
    Do While buf <> ""
        i = i + 1
        sht.Cells(i, 1) = buf
        buf = Dir()
    Loop

Set sht = Nothing

End Sub

フォルダ指定フォルダの最下階層までフォルダやファイルを参照ZIP対象(NameSpace)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Dim FName() As String, FPath() As String, cntF As Long
Dim LName() As String, LPath() As String, LSize() As Double, cntL As Long

Sub FolderInFolderFileReference( _
  ByRef FNm() As String, ByRef FPt() As String, _
  ByRef LNm() As String, ByRef LPt() As String, ByRef LSz() As Double)
'****************************************************************
'指定フォルダの最下階層までフォルダやファイルを参照(NameSpace)
'****************************************************************
'F:Folder   を示します。
'L:File     を示します。
'ZIPファイル対象。

Dim objShlApp As Object
Dim objNmSpc As Object
Dim objFldItmS As Object
Dim n As Long

'再初期化と動的配列のメモリの解放
Erase FName
Erase FPath
Erase LName
Erase LPath
cntF = 0
cntL = 0

Set objShlApp = CreateObject("Shell.Application")
Set objNmSpc = objShlApp.NameSpace(ThisWorkbook.Path)
Set objFldItmS = objNmSpc.Items()

Call WorkToRecur(objFldItmS)

'コピー
FNm = FName: FPt = FPath
LNm = LName: LPt = LPath: LSz = LSize

Set objFldItmS = Nothing
Set objNmSpc = Nothing
Set objShlApp = Nothing
End Sub

Private Sub WorkToRecur(objTmpFldItmS)
'********************************
'再帰処理
'********************************
Dim objFldItm As Object
Dim objItm As Object
Dim n As Variant

    For n = 0 To objTmpFldItmS.Count - 1
        Set objItm = objTmpFldItmS.Item(n)

            If objItm.IsFolder Then
                'Case Folder
                ReDim Preserve FName(cntF) As String
                ReDim Preserve FPath(cntF) As String

                FName(cntF) = objItm.Name
                FPath(cntF) = objItm.Path

                cntF = cntF + 1

                Set objFldItm = objItm.GetFolder
                '再帰呼出
                Call WorkToRecur(objFldItm.Items())
            Else
                'Case File
                ReDim Preserve LName(cntL) As String
                ReDim Preserve LPath(cntL) As String
                ReDim Preserve LSize(cntL) As Double
                LName(cntL) = objItm.Name
                LPath(cntL) = objItm.Path
                LSize(cntL) = objItm.Size
                cntL = cntL + 1
            End If
    Next n

Set objItm = Nothing
Set objFldItm = Nothing

End Sub

Option Explicit

Private Sub Test()
Dim FNm() As String, FPt() As String
Dim LNm() As String, LPt() As String, LSz() As Double
Dim n As Long

Call FolderInFolderFileReference(FNm, FPt, LNm, LPt, LSz)

For n = LBound(FNm) To UBound(FNm)
    Debug.Print FNm(n) & vbTab & FPt(n)
Next n
MsgBox UBound(FNm) + 1

For n = LBound(LNm) To UBound(LNm)
    Debug.Print LNm(n) & vbTab & LSz(n)
Next n
MsgBox UBound(LNm) + 1
'0101.jpg    4956
'0102.jpg    4853
'0103.jpg    4383
'0104.jpg    4360
'0105.jpg    3961
End Sub

フォルダ指定フォルダ指定拡張子のファイル一覧を変数で返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Sub FileVariableInFolder(ByRef strFile() As String _
, ByVal strFolderPath As String, ByVal strExtension As String)
'**************************************************
'指定フォルダ指定拡張子のファイル一覧を変数で返す
'**************************************************

Dim buf As String, i As Long
    i = 0
    buf = Dir(strFolderPath & "\*." & strExtension)
    Do While buf <> ""
        ReDim Preserve strFile(i) As String
        strFile(i) = buf
        i = i + 1
        buf = Dir()
    Loop

End Sub

Private Sub test()
Dim strFile() As String
Dim strFolderPath As String
Dim strExtension As String

strFolderPath = ThisWorkbook.Path & "\xxx\xxxxx\photo"
strExtension = "jpg"
Call FileVariableInFolder(strFile, strFolderPath, strExtension)

MsgBox "最初のファイル名は：" & strFile(LBound(strFile))
MsgBox "最後のファイル名は：" & strFile(UBound(strFile))
MsgBox "合計数：" & UBound(strFile) + 1

End Sub

フォントフォントの一覧をシートに書き出す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub UseFont()

Dim objcombo As CommandBarComboBox
Dim strFontName As String
Dim intFor As Integer
Dim sht As Worksheet
Dim lngThisRow As Long

Set sht = ActiveWorkbook.ActiveSheet
Set objcombo = CommandBars(4).Controls(1)

sht.Range("a1").Value = "FontName"

For intFor = 1 To objcombo.ListCount
strFontName = objcombo.List(intFor)
lngThisRow = sht.Range("a1").CurrentRegion.Rows.Count + 1
sht.Range("a" & lngThisRow).Value = strFontName
Next intFor

Set sht = Nothing
Set objcombo = Nothing

End Sub

フォルダ指定フォルダ内の指定拡張子ファイルの数をカウント

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

Function NumberExtensionFilesInFolder(tgtPath As String) As Long
'************************************************
'指定フォルダ内の指定拡張子ファイルの数をカウント
'************************************************
'引数：tgtPath には取得列挙するフォルダフルパスを指定

Dim buf As String, i As Long
Dim 拡張子指定 As String

拡張子指定 = "jpg"

buf = Dir(tgtPath & "\*." & 拡張子指定)
Do While buf <> ""
i = i + 1
buf = Dir()
Loop

NumberExtensionFilesInFolder = i

End Function

フォントフォントを指定してヘッダーとフッターを設定する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub フォントを指定してヘッダーとフッターを設定する()
'*************************************************
'フォントを指定してヘッダーとフッターを設定する
'*************************************************
'＜コメント＞
'※1 LeftHeader､CenterHeader､RightHeaderとは､左側､中央､右側ヘッダー
'※2 LeftFooter､CenterFooter､RightFooterとは､左側､中央､右側フッター
    With ActiveSheet.PageSetup
        .LeftHeader = "&""ＭＳＰゴシック""ＭＳＰゴシック"
        .CenterHeader = "&""ＤＦ特太ゴシック体,標準""&16ＤＦ特太ゴシック体"
        .RightHeader = "&""HG丸ｺﾞｼｯｸM-PRO,ﾒﾃﾞｨｳﾑ""HG丸ｺﾞｼｯｸM-PRO"
        .LeftFooter = "&""ＭＳ明朝,標準""ＭＳ明朝"
        .CenterFooter = "&""ＭＳＰ明朝,標準""ＭＳＰ明朝"
        .RightFooter = "&""ＭＳゴシック,標準""ＭＳゴシック"
    End With
End Sub

ページ設定ヘッダー・フッター書式設定

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub ページ番号などをヘッダーとフッターに設定する()
'*******************************
'ヘッダー・フッター書式設定
'*******************************

    With ActiveSheet.PageSetup
        .LeftHeader = "&P"
        .CenterHeader = "&P+5"
        .RightHeader = "&P-5"
        .LeftFooter = "&B &P"
        .CenterFooter = "&I &P / &N"
        .RightFooter = "&B&I&P / &N"
    End With
End Sub

ページ設定ファイル名と日付をヘッダーとフッターに設定する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub ファイル名と日付をヘッダーとフッターに設定する()
'***********************************************
'ファイル名と日付をヘッダーとフッターに設定する
'***********************************************
    With ActiveSheet.PageSetup
        .LeftHeader = "&F"
        .CenterHeader = "&E&14&F &A"
        .RightHeader = "&A"
        .LeftFooter = "&D"
        .CenterFooter = "&U&D &T"
        .RightFooter = "&S&T"
    End With
End Sub

ページ設定ページ設定［PageSetup］内容全て設定する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub ページ設定()
'
' ページ設定［PageSetup］
'

    With ActiveSheet.PageSetup


        '’●ページ
        '’ページ（印刷の向き）（参考：横）
        .Orientation = xlLandscape
        '’ページ（印刷の向き）（参考：縦）
        '’.Orientation = xlPortrait
        '’ページ（拡大縮小印刷）（拡大/縮小）
        .Zoom = 100
        '’ページ（拡大縮小印刷）（横）
        .FitToPagesWide = 8
        '’ページ（拡大縮小印刷）（縦）
        .FitToPagesTall = 9
        '’ページ（用紙サイズ）
        .PaperSize = xlPaperA4
        '’ページ（印刷品質）
        .PrintQuality = 300
        '’ページ（先頭ページ番号）
        .FirstPageNumber = xlAutomatic
        '’ページの方向（参考：左から右）
        .Order = xlDownThenOver
        '’ページの方向（参考：上から下）
        '’.Order = xlOverThenDown


        '’●余白
        '’余白（余白左）
        .LeftMargin = Application.InchesToPoints(0.984251968503937)
        '’余白（余白右）
        .RightMargin = Application.InchesToPoints(0.590551181102362)
        '’余白（余白上）
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        '’余白（余白下）
        .BottomMargin = Application.InchesToPoints(0.78740157480315)
        '’余白（ヘッダーの余白）
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        '’余白（フッターの余白）
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        '’余白（ページ中央）水平
        .CenterHorizontally = True
        '’余白（ページ中央）垂直
        .CenterVertically = False


        '’●ヘッダーフッター
        '’ヘッダーフッター（ヘッダーの編集）左
        .LeftHeader = ""
        '’ヘッダーフッター（ヘッダーの編集）中
        .CenterHeader = ""
        '’ヘッダーフッター（ヘッダーの編集）右
        .RightHeader = "&""TT-JTC古印体,Light""&10‐御見積仕様書‐"
        '’ヘッダーフッター（フッターの編集）左
        .LeftFooter = ""
        '’ヘッダーフッター（フッターの編集）中（参考：シート名）
        .CenterFooter = "&A"
        '’ヘッダーフッター（フッターの編集）中（参考：ページ/ページ）
        '’.CenterFooter = "Page &P/&N"
        '’ヘッダーフッター（フッターの編集）右
        .RightFooter = "&""Harlow Solid Italic,斜体""&14Aiei"


        '’●シート
        '’シート（印刷範囲）
        .PageSetup.PrintArea = "$A$1:$BO$46"
        '’シート（行のタイトル範囲）
        .PrintTitleRows = ""
        '’シート（列のタイトル範囲）
        .PrintTitleColumns = "$A:$E"
        '’シート（印刷）（枠線）
        .PrintGridlines = False
        '’シート（印刷）（白黒印刷）
        .BlackAndWhite = False
        '’シート（印刷）（簡易印刷）
        .Draft = False
        '’シート（印刷）（行列番号）
        .PrintHeadings = True
        '’シート（印刷）（コメント）
        .PrintComments = xlPrintNoComments


    End With

    '’プレビュー
    ActiveWindow.SelectedSheets.PrintPreview

End Sub

ブック実質オープン

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub 実質オープン()
'*******************************************************************************
'実質オープン
'*******************************************************************************
アプリ非表示
画面を更新しない
    Dim 要素

    For Each 要素 In Workbooks                  '各ワークブックに対して反復処理する
        If 要素.Name <> ThisWorkbook.Name Then  'コード実行中のブック名と違うなら
            要素.Close savechanges:=False       '保存しないで閉じる
        End If
    Next
frmMain.Show
End Sub

ブックブック保護シート保護

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub psbブック保護(Mybook As Workbook)
'*******************************************************************************
'ブック保護
'*******************************************************************************
    Mybook.Protect Password:=fncPass, Structure:=True, Windows:=False 'ブック保護
End Sub

Sub psbブック非保護(Mybook As Workbook)
'*******************************************************************************
'ブック非保護
'*******************************************************************************
    Mybook.Unprotect Password:=fncPass                  'ブック非保護
End Sub

Sub psbシート保護(Mysht As Worksheet)
'*******************************************************************************
'シート保護
'*******************************************************************************
    Mysht.Protect Password:=fncPass, DrawingObjects:=True, Contents:=True, Scenarios:=True 'シート保護
End Sub

Sub psbシート非保護(Mysht As Worksheet)
'*******************************************************************************
'シート非保護
'*******************************************************************************
    Mysht.Unprotect Password:=fncPass
End Sub

ブック全てのブックを保存し､閉じるマクロ

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub psb全ブック保存閉()
'*******************************************************************************
'全てのブックを保存し､閉じるマクロ
'*******************************************************************************
Dim w
    For Each w In Application.Workbooks
    w.Save
    Next w
    Workbooks.Close
End Sub

メールメーラー「OUTLOOK」を起動する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Shell "C:\Program Files\Microsoft Office\Office\OUTLOOK.EXE", vbMinimizedFocus

'Shell 関数
'
'
'実行可能プログラムを実行し、実行が完了するとプログラムのタスク ID を示すバリアント型 (内部処理形式 Double の Variant) の値を返します。
'プログラムの実行に問題が発生した場合は､0 を返します｡
'
'構文
'
'Shell(pathname[,windowstyle])
'
'Shell 関数は､次の名前付き引数から構成されます｡
'
'指定項目内容
'pathname 必ず指定します。バリアント型 (内部処理形式 String の Variant) の値を指定します。
'実行するプログラム名と必要な引数名またはコマンドラインのスイッチを指定します｡
'また､フォルダ､またはドライブを含めて指定できます｡
'Macintosh では、MacID 関数を使ってアプリケーションの名前の代わりにシグネチャを指定できます。
'
'次の例は、Microsoft Word のシグネチャを使用したものです。
'Shell MacID("MSWD")
'
'windowstyle 省略可能です｡
'実行するプログラムのウィンドウの形式に対応するバリアント型 (内部処理形式 Integer の Variant) の値を指定します。
'引数 windowstyle を省略すると、プログラムはフォーカスを持った状態で最小化され、実行を開始します。
'Macintosh (System 7.0 以降) では、windowstyle は、アプリケーションの実行中に、そのアプリケーションがフォーカスを取得できるかどうかを指定するだけです。
'
'
'名前付き引数 windowstyle には、次の値を指定します。
'
'定数値内容
'vbHide 0 フォーカスを持ち、非表示にされるウィンドウ。定数 vbHide は、Macintosh では使用できません。
'vbNormalFocus 1 フォーカスを持ち、元のサイズと位置に復元されるウィンドウ
'vbMinimizedFocus 2 フォーカスを持ち、最小化表示されるウィンドウ
'vbMaximizedFocus 3 フォーカスを持ち、最大化表示されるウィンドウ
'vbNormalNoFocus 4 最後にウィンドウを閉じたときのサイズと位置に復元されるフォーカスを持たないウィンドウ。現在アクティブなウィンドウは、アクティブのままです。
'vbMinimizedNoFocus 6 最小化表示されるフォーカスを持たないウィンドウ。現在アクティブなウィンドウは、アクティブのままです。
'
'
'解説
'
'指定したプログラムが問題なく実行できると、プログラムのタスク ID が返されます。
'タスク ID は、実行中のプログラムを識別する重複しない番号です。
'指定されたプログラムが実行できないと､エラーが発生します｡
'Microsoft Windows 上で、MacID 関数を使用するとエラーが発生します。
'
'Macintosh では、vbNormalFocus、vbMinimizedFocus、vbMaximizedFocus はすべてアプリケーションをフォアグラウンドで実行し、
'vbHide､vbNoFocus､vbMinimizeFocus はすべてアプリケーションをバックグラウンドで実行します｡
'
'メモ既定の設定では、Shell 関数はプログラムを非同期的に実行します。
'したがって、Shell 関数を使用して実行を開始したプログラムが終了しなくても、Shell 関数の次のステートメントは実行されます。
'
'
'Shell 関数の使用例
'次の例は､Shell 関数を使って､ユーザーが指定したアプリケーションを実行します｡
'Macintosh でファイル名が変わってしまったアプリケーションを実行するには、MacID 関数を使用すると確実です。
'Macintosh では、既定のドライブ名は "HD:" です。パス名は、円記号 (\) ではなくコロン (:) で区切ります。
'また、Windows フォルダの代わりに Macintosh フォルダを指定します。

' Microsoft Windows では、2 番目の引数に 1 を指定すると、
' アプリケーションが通常のサイズで開かれ、そのアプリケーションに
' フォーカスが移ります。

Dim RetVal
RetVal = Shell("C:\WINDOWS\CALC.EXE", 1)    ' 電卓を実行します。

' Macintosh では、次のいずれのステートメントでも、Microsoft Excel を実行します。
RetVal = Shell("Microsoft Excel")        ' ファイル名を指定します。
RetVal = Shell(MacID("XCEL"))            ' シグネチャを指定します。

ページ設定ヘッダーを1枚毎変えながら印刷する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Sub ヘッダーを変えながら印刷する()
'
' 手書表 (1)を指定枚数、ヘッダーを変えながら印刷する。
'
'
Const strX As String = "ヘッダーを変えながら印刷する"
Dim shtKyudanName As Worksheet
Dim shtHyou As Worksheet
Dim strPrintSuu As String
Dim strName As String

'
If MsgBox("手書表を印刷しますか？", vbOKCancel, strX) = vbCancel Then Exit Sub

MyRE:
strPrintSuu = InputBox("何枚づつ印刷しますか？", strX, 1)

If IsNumeric(strPrintSuu) = False Then
If MsgBox("数値で入力されていません！もう一度入力しますか？", vbYesNo + vbCritical, strX) = vbNo Then
Exit Sub
Else
GoTo MyRE:
End If
End If

Set shtKyudanName = ThisWorkbook.Sheets("球団名")
Set shtHyou = ThisWorkbook.Sheets("手書表 (1)")

Dim intKyudanSuu As Integer, intFor(1) As Integer

With shtKyudanName

intKyudanSuu = .Range("b1").CurrentRegion.Rows.Count

For intFor(1) = 2 To intKyudanSuu

strName = .Range("b" & intFor(1)).Value

shtHyou.PageSetup.LeftHeader = "&""ＭＳゴシック,太字""&16" & strName

shtHyou.PrintOut Copies:=CLng(strPrintSuu), Collate:=True

Next intFor(1)

End With

' .LeftHeader = "&""ＭＳゴシック,太字""&16広島"

Set shtKyudanName = Nothing
Set shtHyou = Nothing

End Sub

ページ設定余白指定cm(センチメートル)で指定する

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit

'通常、マクロの記録では単位（インチ）で記録されます。
'これをステートメント記述する場合に役立ちます。
'使用するメソッドは、CentimeterToPoints(○○)です。
'○○の中にセンチの数値を指定します。
'ちなみに、1inch=72pt=2.54cm(1pt=約0.35mm) です。

With ActiveSheet.PageSetup
      .LeftMargin = Application.CentimetersToPoints(2)
      .RightMargin = Application.CentimetersToPoints(2)
      .TopMargin = Application.CentimetersToPoints(2)
      .BottomMargin = Application.CentimetersToPoints(2.5)
      .HeaderMargin = Application.CentimetersToPoints(2.5)
      .FooterMargin = Application.CentimetersToPoints(2.5)
End With

メールメール送信するサンプル

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Dim objoutlook As Object
Dim objoutlookmsg As Object

Set objoutlook = CreateObject("outlook.apprlication")
Set objoutlookmsg = objoutlook.createitem(0)
Set objattachments = objoutlookmsg.attachments

With objattachments
.Add "ファイル名"
With objoutlookmsg
.Recipients.Add "アドレス"
.Subject = "題名"
.body = "本文"
.send
End With
End With
Set objoutlookmsg = Nothing
Set objoutlook = Nothing

'SendMail使用の場合
vntMailAd = Array("A", "B", "C") '複数同時送信配列
Workbooks(D).SendMail Recipients:=vntMailAd, Subject:="TEST" '題名"TEST"Workbooks(D)送信

メールメール送信(CDO.Configuration)

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub SendMail(TantouMei As String, MailAdd As String, Kenmei As String, Honbun As String)
On Error GoTo erroeshori

    With CreateObject("CDO.Message")
        Set .Configuration = CreateObject("CDO.Configuration")
        .From = MsgFrom
        .To = MailAdd
        .Subject = Kenmei
        .TextBody = Honbun
        .Send
        Set .Configuration = Nothing
    End With

MsgBox "送信完了しました", vbInformation, Me.Caption
Exit Sub

erroeshori:
MsgBox Err.Number & vbCr & Err.Description, vbExclamation, Me.Caption
MsgBox "以上の理由によりメッセージが送信できませんでした。", vbCritical, Me.Caption

End Sub

ループループ（Do_While_Loop）の記述

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Do While DateSerial(dateYearMax, dateMonthMax, dateDayMax) + 1 > dateKariDate

dateKariDate = CDate(dateKariDate) + 1

With shtWork
rngA = rngA + 1
.Range("k" & rngA).Value = dateKariDate
End With

Loop

Atn 関数

Atan2

Atn 関数

Sgn 関数

Hex 関数

指定した値を 16 進数で表した文字列型 (String) を返します。

構文

引数 number には

解説

number の値 戻り値

配列の指定された次元で使用できる最小の添字を、長整数型 (Long)の値で返します。

配列の指定された次元で使用できる添字の最大値を、長整数型 (Long) の値で返します。

FreeFile 関数

使用可能なファイル番号を整数型 (Integer) の値で返すファイル入出力関数です。

構文

引数

rangenumber

解説

FreeFile 関数の使用例

EOF 関数

ランダム アクセス モード (Random) またはシーケンシャル入力モード (Input) で開いたファイルの現在位置がファイルの末尾に達している場合、ブール型 (Boolean) の値の真 (True) を含む整数型 (Integer) の値を返します。

構文

引数

filenumber

解説

EOF 関数の使用例

関連ページ

関連ページ

関連ページ

関連ページ

number の値戻り値

ランダムアクセスモード (Random) またはシーケンシャル入力モード (Input) で開いたファイルの現在位置がファイルの末尾に達している場合、ブール型 (Boolean) の値の真 (True) を含む整数型 (Integer) の値を返します。