|
|
|
Access 付属の【 MSCAL.ocx 】
アクセスに付属するカレンダーコントロール[MSCAL.ocx]には一部のプロパティで
同じ値を使っていても、バージョンによって、表示内容が違う
という互換性問題があります。
--- プロパティ --- （その他のプロパティは、こちらを参照）
DayLength
[曜日]タイトルの日本語/英語 表記
MSCAL Ver 〜9 「0(日)， 1(S)， 2(Sun)」
MSCAL Ver10〜 「0(日曜日)， 1(日)， 2(Sunday)， 3(Sun)」
（英語版 Excel 「0(S)， 1(Sun)， 2(Sunday)」 ）
FirstDay
カレンダーの左端に来る曜日
MSCAL Ver 〜9 「1(日), 2(月), ‥‥ 6(金), 7(土)」
MSCAL Ver10〜 「1(月), 2(火), ‥‥ 6(土), 7(日)」
Access2000に付属するのが[9.0]、 Access2002に付属するのが[10.0]です。
参考ＨＰ ： すぐに役立つエクセルＶＢＡマクロ集 ( 解説ページ )
[ACC2002]カレンダーコントロールのプロパティの設定値で異なる結果が表示
補) [DayLength]の「設定値と表示内容」が上記で異なっていますが 『すぐに役立つ』の方が正しいです。
これに対処するには、バージョンによって設定値を切り換える必要があります。
If (MSCALのバージョン <= 9) Then
Calendar1.DayLength = 0
Calendar1.FirstDay = 1
Else
Calendar1.DayLength = 1
Calendar1.FirstDay = 7
End If
Excelでバージョン情報といえば「 Val( Application.Version ) 」という方法で、
Excel97x：８ Excel2000x：９ Excel2002x：１０ Excel2003x：１１
という数値を取得できます。
しかし、Excel側から見た場合に、Excel2000だから[MSCAL 9.0]、Excel2002だから[MSCAL 10.0]と
確実には言えません。例えば、
・ [OFFICE2002Personal + Access2000]という環境ならば、
Excel2002であっても、MSCALはVer９
・ [OFFICE2000Pro] & [OFFICE2002Pro]という風に複数のバージョンがある
環境ならば、Excel2000であっても、MSCALはVer１０
となります。したがって、Excel/VBAにおいて[Application.Version]を使って設定値を切り換えるという
方法は１００％の解決法とは言えません。
[Application.Version]を使って振り分けても支障が無いのは
Excel と Access のバージョンが同じで、複数バージョンのインストールを行なっていない
という環境に限られます。
ただ、業務に使っているＰＣならば
[OFFICE (Pro ) ]の、どれかのバージョンがひとつだけ入っている
というのが普通でしょう。それで、
ＰＣによって、そのOFFICEのバージョンが違う
というのが、当たり前の状況だと思いますので、この場合は[Application.Version]を利用しても
支障はありません。開発ＰＣでは、上記のような複数バージョンのインストールが充分にありえます
ので、この場合には支障があります。
では、確実な方法は何かと言えば、「MSCALのバージョンそのものを取得する」という事になります。
バージョンを取得する方法として
(1) レジストリ情報から読み取る
(2) [MSCAL.ocx]のファイル情報にある「バージョン」を取得する
があります。
【 レジストリ情報 】からMSCALのバージョンを読み取る方法 （2004/8/22 修正）
[HKEY_CLASSES_ROOT]直下の[MSCAL.Calendar]というキーには、上図のように文字列で
"カレンダー コントロール 9.0" とか "カレンダー コントロール 10.0"
という値が入っています（MSCAL がインストールされている場合）。
下記に、このレジストリ情報を読み込んで、最後の数字部分を抜き出すマクロ（関数）を用意しました。
尚、このマクロは
『 新山(へろぱ)のホームページ ( Archive ) の[VB Tips / レジストリの情報を設定・取得] 』
で公開されているコードを参考にして、上記キーに特化するように編集して作成しました。
この中で使っているＡＰＩ関数（RegOpenKeyEx , RegQueryValueEx , RegCloseKey ）の解説は
『 ちょくとのページ / HSPの裏技？？ / Win32 API 関数リスト 』
を参考にしてください。
2004/4/17 現在、このレジストリ取得マクロは、下記環境での動作確認が取れています。
・ OS[Win98SE] ＆ Access[2000SR1] ＆ Excel[97SR2 , 2000SR1 , 2002SP2 混在]
・ OS[Win XP pro] & [Office XP Dev]
[ 2004/8/22 修正 ]
MSCAL.ocx の複数バージョンがインストールされている場合で、
[MSCAL.Calendar ] := "カレンダーコントロール 8.0"
[MSCAL.カレンダー] := "Calendar Control 10.0"
というキーの設定になっている（使っているのは 10.0 ）という方から
このマクロでは、使っていない『８』の方が読み込まれる。
こういうケースでは[CLSID]から読めば、確実に使っている方を読み込める。
というご指摘を受けました。MSCAL の[CLSID]は下記になります。
「上記以外の環境でも問題なく動作した」 または 「こういう環境で不具合が有った」という情報が
あれば、掲示板「あどいん らうんじ」またはメールにてお知らせください。
【利用方法】
下記のコードを全て「標準モジュール」内に貼り付けて下さい。
MSCALを使うユーザーフォームの[UserForm_Initialize]内で下記のように使います。
Select Case ktMscalVerGet
Case 0
'MSCAL未インストール or レジストリ読取エラー
Case Is <= 9
Calendar1.DayLength = 0
Calendar1.FirstDay = 1
Case Else
Calendar1.DayLength = 1
Calendar1.Firstday = 7
End Select
---------- マクロ コード ここから ------------------------------------
---------- マクロ コード ここまで ------------------------------------
'[レジストリ]RegOpenKeyEx/RegQueryValueEx
Private Const ERROR_SUCCESS As Long = 0
Private Const KEY_QUERY_VALUE As Long = &H1 ' サブキーデータの問い合わせを許可｡
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8 ' サブキーの列挙を許可。
Private Const KEY_NOTIFY As Long = &H10 ' 変更の通知を許可｡
Private Const KEY_CREATE_SUB_KEY As Long = &H4 ' サブキーの作成を許可｡
Private Const KEY_CREATE_LINK As Long = &H20 ' シンボリックリンクの作成を許可｡
Private Const KEY_SET_VALUE As Long = &H2 ' サブキーデータの設定を許可｡
Private Const KEY_ALL_ACCESS As Long = KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or _
KEY_CREATE_SUB_KEY Or _
KEY_CREATE_LINK Or _
KEY_SET_VALUE
Private Const KEY_READ As Long = KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY
Private Const KEY_WRITE As Long = KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY
'[レジストリ]キー(EnumはExcel97では使えない)
'Private Enum hKeyConstants
' HKEY_CLASSES_ROOT = &H80000000
' HKEY_CURRENT_USER = &H80000001
' HKEY_LOCAL_MACHINE = &H80000002
' HKEY_USERS = &H80000003
' HKEY_PERFORMANCE_DATA = &H80000004
' HKEY_CURRENT_CONFIG = &H80000005
' HKEY_DYN_DATA = &H80000006
'End Enum
' [レジストリ]DWORD型のタイプ(EnumはExcel97では使えない)
'Private Enum RegTypeConstants
' REG_NONE = (0) ' 定義されていない種類
' REG_SZ = (1) ' NULL で終わる文字列
' REG_EXPAND_SZ = (2) ' 展開前の環境変数への参照 が入った NULL で終わる文字列
' REG_BINARY = (3) ' 任意の形式のバイナリデータ
' REG_DWORD = (4) ' 32 ビット値
' REG_DWORD_LITTLE_ENDIAN = (4) ' リトルエンディアン形式の 32 ビット値
' REG_DWORD_BIG_ENDIAN = (5) ' ビッグエンディアン形式の 32 ビット値
' REG_LINK = (6) ' Unicode のシンボリックリンク
' REG_MULTI_SZ = (7) ' NULL で終わる文字列の配列
' REG_RESOURCE_LIST = (8) ' デバイスドライバのリソースリスト
'End Enum
' [レジストリ]指定されたキーをオープンする。
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
' [レジストリ]オープンされたキーに関連付けられている指定された値を取得する。
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
' [レジストリ]指定されたキーのハンドルを閉じる。
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'_/_/_/_/_/ ktMscalVerGet _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
'_/
'_/ ※ このマクロではレジストリを操作(読込)しています。
'_/ コードの内容を良く理解した上で、自己責任にて利用して下さい。
'_/ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'_/ レジストリの
'_/ [ HKEY_CLASSES_ROOT\MSCAL.Calendar ] または
'_/ [ HKEY_LOCAL_MACHINE\Software\CLASSES\CLSID\
'_/ {8E27C92B-1264-101C-8A2F-040224009C02} ]
'_/ から、カレンダーコントロールMSCAL.ocxのVersionを取得する
'_/ Key内容："カレンダー コントロール 9.0"
'_/ "カレンダー コントロール 10.0"
'_/ "Calendar Control 10.0" など
'_/
'_/ 返却値 0 : MSCALなし/レジストリ読取エラー
'_/ 8,9,10,11等 : MSCALのバージョン番号
'_/
'_/ 作成：角田 http://www.h3.dion.ne.jp/~sakatsu/index.htm
'_/ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'_/ 新山(へろぱ)のホームページの[VB Tips]を参考にして作成
'_/ http://www31.ocn.ne.jp/~heropa/
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Public Function ktMscalVerGet() As Integer
Dim lnghSubKey As Long
Dim lngResult As Long
Dim strBuffer As String
Dim strRetVal As String
Dim i As Integer
Dim j As Integer
Dim strVer As String
' - - - - - - - - - - - - - - - - - - - - - - - -( セルへの記述は不可 )
If (TypeName(Application.Caller) = "Range") Then
ktMscalVerGet = 0
Exit Function
End If
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ktMscalVerGet = 0 '初期返却値(MSCALなし/レジストリ読取エラー)
' レジストリの指定したキーをオープンする(Excel97ではEnum値が使えない)
' lngResult = RegOpenKeyEx(HKEY_CLASSES_ROOT, "MSCAL.Calendar", _
' 0, KEY_ALL_ACCESS, lnghSubKey)
' lngResult = RegOpenKeyEx(&H80000000, "MSCAL.Calendar", _
' 0, KEY_ALL_ACCESS, lnghSubKey)
' (2004/8/22 [CLSID]からの読み込みに修正)
' lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
' "Software\CLASSES\CLSID\{8E27C92B-1264-101C-8A2F-040224009C02}", _
' 0, KEY_ALL_ACCESS, lnghSubKey)
lngResult = RegOpenKeyEx(&H80000002, _
"Software\CLASSES\CLSID\{8E27C92B-1264-101C-8A2F-040224009C02}", _
0, KEY_ALL_ACCESS, lnghSubKey)
If (lngResult = ERROR_SUCCESS) Then
' バッファを確保する。
strBuffer = String(256, vbNullChar)
' レジストリの読み込み(Excel97ではEnum値が使えない)
' lngResult = RegQueryValueEx(lnghSubKey, "", 0, REG_SZ, _
' ByVal strBuffer, _
' Len(strBuffer))
lngResult = RegQueryValueEx(lnghSubKey, "", 0, 1, _
ByVal strBuffer, _
Len(strBuffer))
If (lngResult = ERROR_SUCCESS) Then
strRetVal = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
'キー内容末尾にある番号部分を抜き出す
For i = Len(strRetVal) To 1 Step -1
j = i
Select Case Mid(strRetVal, i, 1)
Case "."
Case "0" To "9"
Case Else
Exit For
End Select
Next i
strVer = Mid(strRetVal, (j + 1))
ktMscalVerGet = Val(strVer)
End If
' レジストリのクローズ
lngResult = RegCloseKey(lnghSubKey)
End If
End Function
【 ファイル情報 】からMSCALのバージョンを取得する方法
エクスプローラーで、ファイルを右クリックして表示される「ファイルのプロパティ」にもバージョン
情報があります。VBAからでもＡＰＩを使う事で、この情報は取得できます。
尚、このマクロは
『 Visual Basic Magazine / 「MSDNの羅針盤」 第7回 バージョンの問題を考えよう 』
で公開されているコードを参考に作成しました。この中で使っているＡＰＩ関数の解説は
GetFileVersionInfoSize 関数 GetFileVersionInfo 関数
VerQueryValue 関数 MoveMemory サブルーチン
を参考にしてください。
ただし、この方法の場合の注意点は、
複数のバージョンのOFFICEがインストールされている環境では
[MSCAL.ocx]のフルパスを指定する必要がある
という事です。ファイル名だけ指定すると、実行中のExcel がインストールされているフォルダ
から読み取ります（AccessもExcelと同じフォルダにインストールされますから、「OFFICEのバ
ージョンがひとつだけ」という普通の環境なら、これで問題はありません）。[OFFICE2002Per
sonal + Access2000]というような環境で「ファイル名だけ指定」とすると、２００２用のフォルダに
[MSCAL.ocx]がありませんので、ＡＰＩ実行が失敗し、バージョン情報の取得ができません。
ユーザーフォーム表示の度に「ファイルをディスク全体から検索してパスを得ておく」というのは、
かなり無駄な事ですので、ブックのオープンイベントなどで最初に取得し、グローバル変数に
保存しておくなどした方が良いでしょう。
【利用方法】
下記のコードを全て「標準モジュール」内に貼り付けて下さい。
ユーザーフォームでの使い方は、レジストリの場合と同じです。
---------- マクロ コード ここから ------------------------------------
---------- マクロ コード ここまで ------------------------------------
' ファイルに関するバージョン情報の構造体
Private Type tagVS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersion As Long
dwFileVersionMSL As Integer
dwFileVersionMSH As Integer
dwFileVersionLSL As Integer
dwFileVersionLSH As Integer
dwProductVersionMS As Long
dwProductVersionLS As Long
dwFileFlagsMask As Long
dwFileFlags As Long
dwFileOS As Long
dwFileType As Long
dwFileSubtype As Long
dwFileDateMS As Long
dwFileDateLS As Long
End Type
' ファイルからバージョン情報を取得できるかどうかを判定する関数の宣言
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" _
Alias "GetFileVersionInfoSizeA" _
(ByVal lptstrFilename As String, lpdwHandle As Long) As Long
' ファイルに関するバージョン情報を取得する関数の宣言
Private Declare Function GetFileVersionInfo Lib "Version.dll" _
Alias "GetFileVersionInfoA" _
(ByVal lptstrFilename As String, ByVal dwHandle As Long, _
ByVal dwLen As Long, lpData As Any) As Long
' バージョン情報リソースから選択された
' バージョン情報を取得する関数の宣言
Private Declare Function VerQueryValue Lib "Version.dll" _
Alias "VerQueryValueA" _
(pBlock As Any, ByVal lpSubBlock As String, _
lplpBuffer As Any, puLen As Long) As Long
' ある位置から別の位置にメモリブロックを移動する関数の宣言
Private Declare Sub MoveMemory Lib "kernel32.dll" _
Alias "RtlMoveMemory" _
(Destination As Any, ByVal Source As Long, ByVal Length As Long)
'_/_/_/_/_/ ktMscalVerGet2 _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
'_/
'_/ [MSCAL.ocx]のファイル情報から
'_/ カレンダーコントロールMSCAL.ocxのVersionを取得する
'_/
'_/ 返却値 0 : MSCALなし/読取エラー
'_/ 8,9,10,11等 : MSCALのバージョン番号
'_/
'_/ 作成：角田 http://addinbox.sakura.ne.jp/index.htm
'_/ (旧サイト) http://www.h3.dion.ne.jp/~sakatsu/index.htm
'_/ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'_/ 「Visual Basic Magazine/MSDNの羅針盤」
'_/ 第7回 「バージョンの問題を考えよう」を参考にして作成
'_/ http://www.galliver.co.jp/writing/msdn/msdn07/
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Public Function ktMscalVerGet2() As Integer
Dim strTargetFileName As String
Dim lngSizeOfVersionInfo As Long
Dim lngDummyHandle As Long
Dim bytDummyVersionInfo() As Byte
Dim lngPointerVersionInfo As Long
Dim lngLengthVersionInfo As Long
Dim udtVSFixedFileInfo As tagVS_FIXEDFILEINFO
Dim lngWin32apiResultCode As Long
' - - - - - - - - - - - - - - - - - - - - - - - -( セルへの記述は不可 )
If (TypeName(Application.Caller) = "Range") Then
ktMscalVerGet2 = 0
Exit Function
End If
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' 対象ファイルを設定
strTargetFileName = "Mscal.ocx"
'複数のOFFICEバージョン環境ではフルパスを指定するか、事前に[Mscal.ocx]
'を検索してパスを取得しておく必要がある。
'strTargetFileName = "C:\Program Files\Microsoft Office\Office\Mscal.ocx"
'strTargetFileName = strMscalPath & "\Mscal.ocx"
' 対象ファイルのバージョン情報のサイズを取得
lngSizeOfVersionInfo = _
GetFileVersionInfoSize(strTargetFileName, lngDummyHandle)
' 対象ファイルのバージョン情報のサイズが取得できたときは
If (lngSizeOfVersionInfo > 0) Then
' ダミー変数の領域を確保
ReDim bytDummyVersionInfo(lngSizeOfVersionInfo - 1)
' 対象ファイルのバージョン情報を取得
lngWin32apiResultCode = _
GetFileVersionInfo(strTargetFileName, _
0, _
lngSizeOfVersionInfo, _
bytDummyVersionInfo(0))
' 対象バージョン情報リソースのルートブロックを取得
lngWin32apiResultCode = _
VerQueryValue(bytDummyVersionInfo(0), _
"\", _
lngPointerVersionInfo, _
lngLengthVersionInfo)
' 取得したルートブロックをバージョン情報の構造体へ移動
Call MoveMemory(udtVSFixedFileInfo, _
lngPointerVersionInfo, _
Len(udtVSFixedFileInfo))
ktMscalVerGet2 = udtVSFixedFileInfo.dwFileVersionMSH
Else
ktMscalVerGet2 = 0
End If
End Function
 |
 |
|
|
|
||
| 角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2001 Allrights Reserved. | ||
