祝祭日対応日付ライブラリ

カレンダー関連のソフトを作る場合、祭日の処理がやっかいです。文化の日のように日付が固定されている祭日は簡単に判断できますが、ややこしいのが いくつかあります。 まずは振替休日。次に春分・秋分の日。そして最近導入された成人の日や体育の日のように移動する祭日（ローミング祭日）としましょうか）です。
普通に画面にカレンダーを表示したい（祝祭日はやっぱ赤にしたいなぁという場合はあきらめもつきますが、業務アプリを作っていて、どうしても祝祭日の処理が必要になる時があります。
例えば、銀行振込処理をするとき、振込指定日を指定します。

「毎月10日で、10日が休みだったら次の営業日」

というような処理をしなければならない時には、祝祭日判定が必須になります。

祝祭日対応日付ライブラリでは、その日が祝祭日であるかどうかを判定できます。また、祝祭日の場合は、なんの祝祭日なのかを文字列で得ることができます。祝祭日の種類は、固定祝祭日・春分秋分・ローミング祭日全てに対応しています。
このライブラリを使えば、祝祭日処理はおてのものです。 サンプルとしてExcelで作った万年カレンダーをつけました。

モジュールの関数

Saijitu関数

Function Saijitu(theDate, Optional doyou As Integer = 0) As String

日付を渡すと祝祭日名を返します。

引数

theDate　調べる日付
doyou　　土曜日の扱い方 0=祝祭日としない 1=第１を祝祭日とする 2=すべて祝祭日とする 3=第２・第４を祝祭日とする

戻り値

戻り値

祝祭日の名称

isSaijitu関数

Function isSaijitu(theDate, Optional doyou As Integer = 0) As Boolean 

祝祭日であるかを判断します。

引数

theDate　調べる日付
doyou　　土曜日の扱い方 0=祝祭日としない 1=第１を祝祭日とする 2=すべて祝祭日とする 3=第２・第４を祝祭日とする

戻り値

戻り値

祝祭日の場合はTrueそうでなければFalse

GetActionDate関数

Function GetActionDate(dActionDate As Date) As Date 

実行日を渡すと、実際に実行可能な日を返します。

引数

dActionDate　実行日

戻り値

実行日が休日の場合は翌営業日を返します。
この間数は週休二日が前提です。

OfficeClosed関数

Function OfficeClosed(theDate, Optional doyou As Integer = 0) As Integer

日付を渡すと、その日のステートを返す。

引数

theDate　日付
doyou　　土曜日の扱い方 0=祝祭日としない 1=第１を祝祭日とする 2=すべて祝祭日とする 3=第２・第４を祝祭日とする

戻り値

日付のステート
1　平日
2　土曜日
3　日曜日・祝祭日

WeekOfMonth関数

Function WeekOfMonth(theDate) As Integer 

月のうち第何週かを求める

引数

theDate　日付

戻り値

月のうち第何週かを数値で返す。

ShunbunDate関数

Function ShunbunDate(iYear As Integer) As Date

その年の春分の日を得る

引数

iYear　西暦年

戻り値

iYearの年の春分の日を日付型で返す。

ShuubunDate関数

Function ShuubunDate(iYear As Integer) As Date

その年の秋分の日を得る

引数

iYear　西暦年

戻り値

iYearの年の秋分の日を日付型で返す。

改版履歴

• 昭和の日と海の日に対応しました。　
• 変に再帰呼び出しをしていたのをやめて高速化しました。
• 国民の祝日に関する法律第３条３項「その前日及び翌日が「国民の祝日」である日（「国民の祝日」でない日に限る。）は、休日とする。」に対応しました。

 

添付	サイズ
ダウンロードはこちら	18.17 KB

Accessを使ってVBの印刷プログラムを自動作成する

　Visual Basicの印刷機能のふがいなさは、みなさんご存じの通りです。MS-Accessのレポート機能の強力さもみなさんご存じの通り。沢山の帳票を出力するような場合には、MS-Accessを使うという方も多いと思います。

　ところがクライアントに配布するプログラムの場合、Accessがインストールされていないなどの理由で、Visual Basicで作成せざるを得ない場合があります。そしてそのプログラムで帳票を打たなければならない「あぁAccessのレポートが使えたらなぁ」と思い ますよね。

　Accessのレポートの良さは、デザインが簡単に行えることです。そこで、Accessでレポートを作成し、それからVisual Basicの印刷プログラムを生成できないか？と考えて作ったのがこのプログラムです。

　ただし、Accessのレポート機能をすべて使えるわけではありません。どちらかというとVisual Basicのプログラミングを少しだけ助けるようなツールです。

ダウンロードはこちら

できること

• Accessレポートの詳細セクションに配置したコントロールから描画ルーチン(Procedure)を自動作成します。
• 自動作成したProcedureは、専用のクラスとととにVisual Basicプロジェクトに読み込めば、印刷ルーチンが完成します。
• 出力先はObject型なので、Printerオブジェクトを指定して印刷することも、Pictureオブジェクトを指定して、プレビューを作ることもできます。
• ソースは完全公開ですので、ご自分ですきなようにカスタマイズできます。
• クライアントプログラムの配布先にはAccessがインストールされている必要はありません。

できないこと

• Accessのようにレコードセットと連携して、詳細セクションを繰り返したり、ヘッダーセクションを印刷したりはできません。そのあたりはコーディングで対応する必要があります。

ダウンロードするファイルの中身

ダウンロードするファイルは、GenGraphic.lzh です。+Lhacaなどで解凍してください。２つのファイルが出てきます。

GenGraphic.mdb　

描画プログラムを作成するmdbです。このmdb上でレポートを作成し、そのレポートを元に描画プログラムを自動作成します。

CDrawGraphic.cls　

生成された描画プログラムが利用するクラスです。生成されたプログラムと一緒に、Visual Basicのプロジェクトにインポートして使います。

使い方

GenGraphic.mdbを起動します。

表示されるフォームの「新規レポート」ボタンを押して、GenGraphic.mdbの中でレポートをデザインしてください。使えるコントロール は、ラベル・テキストボックス・矩形・線の４種類のみです。他のコントロールを配置しても、それに関するコードは生成されません。

線・矩形

Visual BasicのLineメソッドで描画コードを生成します。線の太さや種類もなるべく近いもので描画されるようにコードが作られます。

ラベル

Visual BasicのPrintメソッドでコントロールの標題(Caption)プロパティの値を文字列として描画するコードを生成します。データによって変更のない文字列描画する時に使います。

テキストボックス

Visual BasicのPrintメソッドで、コントロールソース(ControlSource)に設定した式を描画するコードを生成します。変数名でも計算式でも 何でもここに記述したとおりのコードが生成されます。何でもここに記述したとおりになると言うことは、ここに記述した式にエラーがあったら、そのまんまエ ラーになってしまうということでもあります。

ラベル・テキストボックスで使用できるプロパティ

フォント名・フォントサイズ・斜体・太字・下線・左余白・右余白・上余白・文字配置は、描画するコードに設定が反映されます。文字配置は左・右・中央・均等すべて対応しています。行間隔はサポートされません。

またテキストボックスの場合、書式(Format)プロパティの値は、Visual Basic の Format関数の第２引数になります。この値を設定することで、簡単に描画文字列のフォーマットを指定できます。

例）txtDate テキストボックスの「書式」プロパティに 'ggge年m月d日' と設定されていたなら、「平成X年X月X日」と表示されます。

線・矩形・ラベル・テキストボックスで使用できるプロパティ

境界線スタイル・境界線色・境界線幅の各プロパティが描画するコードに反映されます。

矩形・ラベル・テキストボックスで使用できるプロパティ

背景スタイル・背景色の各プロパティが描画するコードに反映されます。Accessのデフォルトでは、テキストボックスの背景スタイルが「普通」に なっていますが、そのままでは背景色で矩形を描画するコードが生成されます。背景色を指定する必要のないコントロールの背景スタイルは「透明」にすること をお勧めします。

レポートのデザインが済んだなら、レポートを保存します。フォームのリストボックスに今作ったレポート名が表示されますので、それを選択後出力するファイル名と描画ルーチンのProcedure名を入力して、プログラム作成ボタンを押すと、プログラムが作成されます。

ラベルコントロールの特殊な使用法

ラベルコントロールのタグプロパティに Param と設定することで、生成されるProcedureが受け取る引数を定義することができます。タグ(Tag)プロパティにPramと設定し、標題 (Caption)プロパティに引数の定義を書きます。例えば Param1 As String の様にVisual Basicの引数定義の文字列を書きます。すると、作成されるProcedureは、

Sub foo(objOutput as Object, Param1 As String)

のように定義されます。印刷ルーチンには沢山のデータを渡さなければならないと思います。その場合は、ユーザー定義型やクラスを渡すようにしてはど うでしょうか。例えば、印刷必要なデータを格納しているクラス CPrintData がある場合、Param指定で、PrData As CPrintData という引数を受け取るようにします。そして、コントロールボックスのコントロールソースプロパティでは、そのクラスのプロパティを印刷するように指定しま す。 PrData.UserName などのように記述するのです。

作成時のオプション

プログラム作成時にいくつかのオプションを選択できます。

• Procedureの宣言をPrivateにするかPublicにするか
• コントロール名をコードの中にコメントとして入れるかどうか

作成した描画ルーチンの呼び出し

Visual Basicのプロジェクトを開いて、作成したファイルとCDrawGraphic.clsファイルをインポートします。インポートされた描画ファイルのモジュール名は、手続き名の頭にmdlをつけたものになります。

印刷を実行したいところに、生成したProcedureをコールするコードを書けば印刷機能を使うことができます。Param指定がない場合のProcedure仕様は次のようになります。

Public Sub 関数名(objOutput as Object,, Optional lTopMargin As Long = 0, _
    Optional lLeftMargin As Long = 0)

引数

• objOutput：描画先のオブジェクト、PrinterオブジェクトやPictureBoxオブジェクトを渡します。
• lTopMargin：ページの上端からのマージンをTwips単位で指定します（省略可能）
• lLeftMargin：同様に左端からのマージンを指定します（省略可能）

Param指定がある場合は、objOutputとlTopMarginの間にParam指定した引数が入ります。

例）手続き名がPrintOutの場合

PrintOut Printer,720,720
    または
Call PrintOut(Printer,720,720)

例）手続き名がPrintOutでPramを２つ指定している場合

PrintOut Printer, Pram1, Param2, 720, 720

著作権・改造・再配布など

GenGraphic.mdb CDrawGraphic.clsともに著作権は、Sunvisor Lab.にあります。

プログラムの改造は自由に行ってくださって結構です。便利な改造を行っていただけたら、フィードバックして頂くとなお結構です。

再配布もご自由にどうぞ。

ご意見なども聞かせてください。

添付	サイズ
ダウンロードはこちらから	121.86 KB

クライアントのプログラムを自動バージョンアップする

Visual Basicを使って、クライアントにプログラムを配布している場合、バグフィックスや機能追加などを行うたびに、インストールをやり直したり、EXEファ イルを入れ替えたりする仕事は結構手間暇がかかって面倒くさいものです。プログラムのユーザーにとっても、アップグレードの度に、自分でインストールする のは面倒でしょうし、仕事中に「ちょっとごめん、アップグレードするからちょっとどいて」と仕事を中断されるのもうっとうしいにちがいありません。

そこで、簡単にEXEファイルをアップグレードする方法を考えてみました。EXEファイル自身に、自分よりも新しいものがリリースされたら、それをコピーしてくる機能をつければいいじゃないか、と。

方法としては、ネットワーク上のファイルサーバーにあるEXEファイルと、今クライアントにあるEXEファイルの日付を比較して、ネットワーク上の ヤツが新しかったら、それをクライアントにダウンロードして、EXEファイルを起動し直す。というやり方です。こうすることで、ユーザーは常に新しいバー ジョンのEXEファイルを使い続けられます。

前提条件

利用環境がネットワークでつながっていること。

最新バージョンを保存してあるフォルダが見えないことにはどうしようもありませんからね。

他のコンポーネントに変更がないこと。

クライアントのPCにインストールされていないかもしれないような、コントロールの使用をし始めたような場合は、単にEXEファイルの交換だけで は、うまく行かない場合が出てきます。そのような大幅な仕様変更があった場合は、インストールのし直しなどをしなければなりません。

利用法

VB版

mdlAutoVerUp.bas をプロジェクトにインポートして、プログラムの最初の方でAutoVersionUpプロシージャをコールします。このProcedureをコールする前 には、フォームをロードしたりいろいろとしない方が良いです。なんせ乱暴に Endステートメントでプログラムを終了させていますから。
お勧めの使い方は、Sub Main をスタートアップとして、Sub Main のなるべく初めの方でこのProcedureをコールする方法です。

Delphi版

Delphi版では、関数になっています。UAutoVerUp.pas をプロジェクトに追加して、プログラムの最初の方で(メインモジュールなど)AutoVersionUp関数を呼び出し、戻り値がtrueの場合には、プログラムを終了するようにコードを書きます。

構文

VB版

AutoVersionUp(sSetUpFolderUNC,[sFileName])

sSetUpFolderUNC	最新バージョンのEXEが格納されているネットワークフォルダのパスをフルUNCパスで指定します。（別に仮想ドライブに割り当てられていてもいいですが、UNCの方が楽だと思います）
sFileName	EXE ファイル以外に、更新する必要があるファイル（たとえばHelpファイルなど）も一緒 に更新したい場合にそのファイル名を指定します。ここでファイル名を指定したものは、EXEファイルと同じフォルダに格納されます。また、 sSetUpFolderUNCで指定したフォルダにそのファイルがなければなりません。 ファイル名は複数指定できます。複数指定する場合は、ファイル名の間をタブ文字（vbTab）で区切って指定します。

Delphi版

result := AutoVersionUp(sSetUpFolderUNC,[FileList]);

sSetUpFolderUNC	最新バージョンのEXEが格納されているネットワークフォルダのパスをフルUNCパスで指定します。（別に仮想ドライブに割り当てられていてもいいですが、UNCの方が楽だと思います）
sFileName	EXE ファイル以外に、更新する必要があるファイル（たとえばHelpファイルなど）も一緒 に更新したい場合にそのファイル名を指定します。ここでファイル名を指定したものは、EXEファイルと同じフォルダに格納されます。また、 sSetUpFolderUNCで指定したフォルダにそのファイルがなければなりません。 ファイル名は複数指定できます。複数指定する場合は、ファイル名の間をカンマで区切って指定します。

動作

まず、sFileNameで指定したファイルを更新します。sFileNameで指定したファイルの内、sSetUpFolderUNC上にあるファイルの方が新しければ、更新します。
次 に、EXEファイル自身の日付を比較します。sSetUpFolderUNC上にあるEXEファイルの方が新しければ、EXEファイルをクライアントにダ ウンロードして、EXEファイルを再起動します。 その際、「 最新版がリリースされました。最新版にアップデートします」とメッセージが表示されます。
Delphi版の場合は、バージョンアップした場合に戻り値にtrueが帰ります。

テクニック

EXEファイルが実行中の時、EXEファイルは開かれた状態になっていますので、EXEファイルを別なところからコピーしてくることはできません。こうしたEXEを更新する処理を書く場合、いくつかの方法が考えられます。

• EXEの更新をチェックする別プログラムを走らせ、当該EXEを実行し始める前にEXEの最新チェックとコピーを終えてしまってから、当該EXEを実行する。
• EXEの中から更新をチェックし、最新版が見つかったらEXEをコピーするプログラムを実行する。

ここでは、後者の方法をとっています。コピーするプログラムを別のEXEで持つのも大げさなので、VBScriptを生成して、VBScriptで EXEファイルのコピーと再起動を行っています。生成するVBScriptは、EXEファイルをコピーし、そのEXEファイルを実行するというものです。 最初に実行したEXEファイルは、VBScriptを実行した直後に終了します。

EXE更新・再起動のスクリプトは、VB Script で記述していますので、クライアントマシンには、Windows Scriptin Host(WSH) がインストールされている必要があります。諸般の事情で、WSHが使えないような場合は、このままで使用することは出来ませんが、生成するスクリプトを バッチファイルにするなどの方法とれば出来ないことはないでしょう。

生成されたスクリプトの中には、MsgBox関数でメッセージを表示しています。これは、ユーザーに「EXEはアップデートされましたよ！」という 意思表示をする意味もありますが、Endステートメントで、EXEプログラムを終了させても、スクリプトでEXEファイルをコピーしようとした時に、まだ EXEの終了処理が終わっていなくて、コピーできないという状況を避けるためでもあります。

 

添付	サイズ
ダウンロードはこちら (VB6版)	1.62 KB
ダウンロードはこちら (Delphi6版)	3.48 KB

二つのVBA用アドイン

VBAのコードエディタで使用する拙作のアドインを2種紹介します。JavaDoc風のコメントを挿入するアドインと，コードチップを挿入するアドインです。ほんの少しだけVBAのコーディングの助けになります。

コメント挿入アドイン

JavaDoc風のコメントを挿入するアドインです。プロシージャ毎／全てのプロシージャ／モジュールに対してコメントの挿入や削除ができます。

インストール

こちらから，アドインのインストーラをダウンロードして，解凍した後，setup.exe を実行してください。その後，VBAエディタ画面で，アドイン(A) > アドインマネージャ(A) で，ロード／アンロード と 起動時にロード のチェックを入れて有効にしてください。

使用法

OfficeのVBAエディタ画面で，アドイン(A) > コメント挿入 を選びます。

メニューダイアログが表示されます。

どれかのボタンをクリックしてください。コメントを挿入した場合つぎのようになります。

このように，ちょっとJavaDocに似た感じのコメントを挿入してくれます。

コードチップ挿入アドイン

コードの断片を挿入するアドインです。

インストール

こちらから，アドインのインストーラをダウンロードして，解凍した後，setup.exe を実行してください。その後，VBAエディタ画面で，アドイン(A) > アドインマネージャ(A) で，ロード／アンロード と 起動時にロード のチェックを入れて有効にしてください。

使用法

OfficeのVBAエディタ画面で，アドイン(A) > コードチップ挿入 を選びます。

リストボックスで挿入したい構文を選択すると，画面下のグリッドに設定できるパラメータが表示されます。パラメータの値を変更したい場合は，値部分をダブルクリックすると変更することができます。

OKボタンをクリックすると，次のようにコードが挿入されます。

カスタマイズ

コードチップは，標準で7つ用意されていますが，独自のコードチップを追加することができます。インストールフォルダ(普通は C:\Program Files\sunvisor\codechip)にあるcodechip.basに書き加えればいいのです。次が標準のcodechip.basの内容の一部です。

':Do While..Loop
'var [$cond]:true:終了条件
'.current
Do While [$cond]
	'<Todo>
Loop
'end
 
':For..Each..Next
'var [$obj]:obj:ループ変数名
'var [$objType]:Variant:ループ変数の型
'var [$Objs]:Objs:配列／コレクション名
'.top
    Dim [$obj] As [$objType]
'.current
For each [$obj] In [$Objs]
    '<ToDo>
Next [$obj]
'end

ひとつのコードチップブロックは，': で始まる行から，'endの行までになります。

':一覧に表示される文字
  (内容)
'end

パラメータで指定する値は，'varに続いて宣言します。

 

'var <プレースホルダ>:<初期値>:キャプション

プレースホルダは，コード中で使用される文字列です。$で始まり[ ] で囲ったものにしてください。そのプレースホルダと初期値とキャプションをコロンで区切って指定します。For..Each..Nextの構文での画面と，codechip.basの記述を比べてみてください。

 

コード部分は，いくつかのセクションに記述します。

'.current	アドインを起動したときのカーソル位置
'.declare	宣言部分
'.top	プロシージャ内の先頭部分
'.bottom	プロシージャ内の最後の部分

コード内に置かれたプレースホルダは，画面上で指定した値で置換されて挿入されます。

インストーラのダウンロード

• コメント挿入アドイン
• コードチップ挿入アドイン

ちょっと使える関数ライブラリ(1)

Accessなどで使える，VBAの関数で，ちょっと使えるものを載せてみました。

年度を得る

簡単なところで，年度を得る関数。年度の始まりは4月固定。

'/**
' * 年度を得る.
' * @return
' * @param ADate
' */
Function GetNendo(ADate As Variant) As Integer
    Dim m As Integer
    Dim Y As Integer
    m = Month(ADate)
    Y = Year(ADate)
    If m < 4 Then
        Y = Y - 1
    End If
    GetNendo = Y
End Function
 

年齢計算

 

上記を使って，年度始めの年齢を計算する。

'/**
' * 年齢計算基準日を得る.
' * 基準日は年度の初めの日
' * @return
' * @param ADate
' */
Function GetBaseDate(ADate As Variant) As Date
    GetBaseDate = DateSerial(GetNendo(ADate), 4, 1)
End Function
 
'/**
' * 基準日での年齢計算.
' * @return
' * @param dBirthDay
' * @param Optional dDate
' */
Function GetAge(dBirthDay As Variant, Optional dDate As Variant = Null) As Variant
    Dim n As Integer
    Dim D As Date
 
    If IsNull(dBirthDay) Or (Not IsDate(dBirthDay)) Then
        GetAge = Null
        Exit Function
    End If
    If IsNull(dDate) Then
        D = Date
    ElseIf IsDate(dDate) Then
        D = dDate
    Else
        GetAge = Null
        Exit Function
    End If
    n = DateDiff("yyyy", dBirthDay, GetBaseDate(D))
    If Format(dBirthDay, "mm/dd") > Format(GetBaseDate(D), "mm/dd") Then
        n = n - 1
    End If
    GetAge = n
End Function
 
 

バイト単位でのMid関数

VBのMid関数は，文字単位で文字を切り出しますが，昔々のBASICのようにバイト数で切り出したいときに使います。

 

'/**
' * バイト単位でのMid関数.
' * @return         切り出された文字列
' * @param AStr     元の文字列
' * @param APos     開始位置
' * @param Optional ALength 長さ
' */
Public Function MidByte(AStr As String, APos As Integer, Optional ALength As Integer = -1)
    Dim temp As String
 
    AStr = StrConv(AStr, vbFromUnicode)
    If ALength < 0 Then
        MidByte = StrConv(MidB(AStr, APos), vbUnicode)
    Else
        MidByte = StrConv(MidB(AStr, APos, ALength), vbUnicode)
    End If
End Function

 

日付を比較してファイル更新

ファイルの日付を比較して，コピー元の方が新しかったらコピーを実行します。

'/**
' * ファイル更新.
' * ファイル日付を比較して新しければファイルをコピーする
' * @param ASource  コピー元ファイル名
' * @param ADest    コピー先ファイル名
' */
Sub UpdateFile(ASource As String, ADest As String)
    On Error Resume Next
    If Len(Dir(ADest)) = 0 Then
        FileCopy ASource, ADest
    ElseIf FileDateTime(ASource) > FileDateTime(ADest) Then
        FileCopy ASource, ADest
    End If
End Sub

 

 

ちょっと使える関数ライブラリ(2)

ここでは，Windows関連の情報を得る関数を集めてみました。WSHを使っているものが多いです。

特殊なフォルダのパスを得る

Special Folder の実際の場所を得ます。引数に取得したいフォルダをVBの定数でセットします。

'/**
' * 特殊なフォルダのパスを得る.
' * @return
' * @param ASpecialFolder   以下を指定可能
' *     AllUsersDesktop, AllUsersStartMenu, AllUsersPrograms, AllUsersStartup, Desktop
' *     Favorites, Fonts, MyDocuments, NetHood, PrintHood, Programs, Recent
' *     SendTo, StartMenu, Startup, Templates
' */
Function GetSpecialFolder(ASpecialFolder As Variant) As Variant
    Dim WShell As Object
 
    Set WShell = CreateObject("WScript.Shell")
    GetSpecialFolder = WShell.SpecialFolders(ASpecialFolder)
End Function
 

Windowsにログオンしているユーザ名を得る

 

'/**
' * Windowsにログオンしているユーザ名を得る.
' * @return
' */
Public Function LogonUser() As String
    Dim WshNetwork As Object
    Dim strUserName As Object
 
    Set WshNetwork = CreateObject("WScript.Network")
    LogonUser = WshNetwork.UserName
    Set WshNetwork = Nothing
End Function

 

コンピュータ名を得る

 

'/**
' * コンピュータ名を得る.
' * @return
' */
Public Function ComputerName() As String
    Dim WshNetwork As Object
    Dim strUserName As Object
 
    Set WshNetwork = CreateObject("WScript.Network")
    ComputerName = WshNetwork.ComputerName
    Set WshNetwork = Nothing
End Function

 

IPAddressを得る

実はこの関数はめっちゃいい加減です。複数NICとか仮想IPとかいろいろある環境で正しくIPを取ろうと思うとこうはいきません。

'/**
' * IPAddressを得る
' * IPアドレスのうちデフォルトゲートウェイがセットされているものを取得しているだけ
' * なので違うアダプタのIPを取得する可能性もある.
' * @return
' */
Public Function IPAddress() As String
    Dim objWMIService, IPConfigSet, IPConfig
 
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set IPConfigSet = objWMIService.ExecQuery _
    ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
    For Each IPConfig In IPConfigSet
        If Not (IsNull(IPConfig.IPAddress) Or _
            IsNull(IPConfig.DefaultIPGateway)) Then
            IPAddress = IPConfig.IPAddress(LBound(IPConfig.IPAddress))
            Exit For
        End If
    Next
End Function
 

 

 

Access VBA のInStr関数がおかしい

InStr関数の戻り値がおかしい。AccessのVBEを起動してイミディエイトウィンドウで試してみてください。

 

? InStr("かきくけこ","こ")
 5
? InStr("がぎぐげご","ご")
 9

なにこれ？でしょ。これはInStr関数の比較モードがデータベースモード(vbDatabaseCompare)の場合にこうなります。比較モードがデータベースモードの場合には，濁点も1文字と数えるという仕様が原因だそうです。Access VBAではデフォルトがこの比較モードなのでわりと頻繁に発生します。

普通に文字列の中から普通に位置を知りたい場合は次のように比較モードを指定します。

? InStr(1,"がぎぐげご","ご",vbTextCompare)
 5

この場合，注意しなければならないのは第1引数（検索開始位置）が省略できなくなることです。ヘルプにも，「引数 compare を指定した場合は、引数 start も指定する必要があります。」とあります。別な回避方法としては，

Option Compare Text

を使う方法がありますが，ここを変更すると普通に文字列の比較をしている部分での動作も違ってきてしまいますので，注意が必要です。

この事実は，普通に

InStr(strFoo, strBar)

という書き方をしている部分は全てバグが発生する可能性があるということを表します。ご自分の書いたコードを見直してInStr関数を使用しているところはすべてチェックすべきでしょう。

参考サイト

[ACC2002] Access プロジェクトで VBA の InStr 関数が返す値が間違っている

 

DoEventsをうまく使う

AccessのVBAで時間のかかる処理をすると，画面が更新されなかったり，Windowsから（応答なし）扱いされたりします。それをさけるためには，DoEventsを呼び出すのですが，なにも考えずに呼び出すとパフォーマンスが大幅に低下します。これをなんとかしようという試みです。

まずは「DoEventsをパフォーマンスを下げずに使う方法」というページに紹介されていた手法を使ってみます。

Private Declare Function GetInputState Lib "USER32" () As Long
 
Public Sub CheckEvents()
    If GetInputState() Then
        DoEvents
    End If
End Sub

これは，GetInputState APIをコールして，待機中のイベントがあればDoEventsをコールするというものです。このCheckEventsプロシージャをDoEventsの代わりにコールすれば，パフォーマンスは低下せず，画面も更新されます。 

しかし，これでもしばらく（10秒ぐらい）Accessのウィンドウを放置しておくと，（応答なし）扱いになり，その後は画面更新もうまくされないようになってしまいます。そこで，一定時間がたったときには待機中のイベントがなくてもDoEventsをコールしてみます。

Private Declare Function GetInputState Lib "USER32" () As Long
Private m_Time As Variant
 
Public Sub CheckEvents()
    If GetInputState() Or (DateDiff("s", m_Time, Time) > 1) Then
        DoEvents
        m_Time = Time
    End If
End Sub

これは，待機中のイベントがあるか，前回の呼び出しより1秒以上経過しているか，いずれかであればDoEventsを呼び出します。モジュールレベル変数のm_Timeに前回呼び出し時の時間がセットされます。このプロシージャをDoEventsの代わりに呼び出せば，パフォーマンスと操作性の両立ができるのではないかと思います。