リレーションシップでデータシートの3階層入力

リレーションシップさえうまく設定すれば、データシート上での3階層入力ができる。

起動時のシフトキー無効

セキュリティの強化として・・・

・データベースウィンドウを表示させない（Shiftキー無効）
・mdeファイルを作成すること。
・起動時の設定ダイアログから、データベースウインドウの非表示及び全てのチェックをはずすこと。
・管理者としてはデータベースウィンドウの表示が必要です。よってパスワード設定で、データベースウィンドウの表示・非表示を切り替える 仕様とすること。


■Shiftキー無効のサンプル

下記のプロシージャをデータベースウィンドのモジュール欄に記述して下さい。全てをコピーしても結構です。

Function　ChangeProperty(strPropName　As　String,　varPropType　,varPropValue)　As　Integer

On　Error　GoTo　エラー

　　　　Dim　dbs　As　Database,　prp　As　Property
　　　　Const　conPropNotFoundError　=　3270
　　　　Set　dbs　=　CurrentDb
　　　　dbs.Properties(strPropName)　=　varPropValue
　　　　ChangeProperty　=　True

　　　　Exit　Function

エラー:
　　　　If　Err　=　conPropNotFoundError　Then　'　プロパティが見つかりません。
　　　　　　　　Set　prp　=　dbs.CreateProperty(strPropName,varPropType,　varPropValue)
　　　　　　　　dbs.Properties.Append　prp
　　　　　　　　Resume　Next
　　　　Else
　　　　　　　　ChangeProperty　=　False　'　認識できないエラー。
　　　　　　　　Exit　Function
　　　　End　If

End　Function




Function　NoShiftKey()

　　　　Dim　strmsg_1　As　String
　　　　Dim　strmsg_2　As　String

　　　　strmsg_1　=　"ファイルを再度立ち上げた後、Shiftキィーが有効になります。"
　　　　strmsg_2　=　"ファイルを再度立ち上げた後、Shiftキィーが無効になります。"
　　　　
　　　　'Shiftキィーを無効、有効にするため、パスワードを要求します。
　　　　Select　Case　InputBox("パスワードを入力してください。")

　　　　　　　　Case　1234　'既定値のパスワードです。自由に変更できます。
　　　　　　　　　　　　ChangeProperty　"AllowBypassKey",　dbBoolean,　True
　　　　　　　　　　　　MsgBox　strmsg_1,　,　"Microsoft　Access　Club"

　　　　　　　　Case　0
　　　　　　　　　　　　ChangeProperty　"AllowBypassKey",　dbBoolean,　False
　　　　　　　　　　　　MsgBox　strmsg_2,　,　"Microsoft　Access　Club"

　　　　　　　　Case　Else
　　　　　　　　　　　　ChangeProperty　"AllowBypassKey",　dbBoolean,　False
　　　　　　　　　　　　MsgBox　strmsg_2,　,　"Microsoft　Access　Club"

　　　　End　Select

End　Function



※NoShiftKeyをフォームに張り付けたボタンのクリックイベントにセットする。



参考URL

リンクテーブルのリンク先を動的に変更する

１.VBAの参照設定で右記をチェックする『Micrsoft ADO Ext *.* for DDL and Security』

２．テーブルのリンク先を変更するVBAを以下に説明します。
作成するVBA
・
・
Dim AdoCat As New ADOX.Catalog
Dim AdoTbl As New ADOX.Table
Dim fPath As String
・
・
fPath = "C:\Documents and Settings\All Users\data.mdb" '変更するmdbパス
AdoCat.ActiveConnection = CurrentProject.Connection
For Each AdoTbl In AdoCat.Tables
　　　If (AdoTbl.Type = "LINK") Then 'リンクされたテーブル？
　　　 AdoTbl.Properties("Jet OLEDB:Link Datasource") = fPath 'mdbパスを変更する
　　　End If
Next
・

イベントの無効/有効を切り替える

■どうやらAccessではイベント制御はなさそう・・・

Flagを使って制御するしかなさそうだ。


Option Compare Database

Dim myEvent As Boolean

'--- ボタンのダブルクリック制御
Private Sub コマンド0_DblClick(Cancel As Integer)

　　' チェック1がチェックされている時だけ、下記処理を実行
　　If myEvent Then
　　　　MsgBox "DblClickイベント発生！"
　　End If
End Sub

Private Sub チェック1_AfterUpdate()
　　myEvent = Me.チェック1.Value
End Sub




■下記はエクセルのみでした・・・残念

Sub PaintOff()
　　Application.EnableEvents = False
End Sub

テーブルの動的リンク

リンクテーブルを動的に変える方法です。
テスト等で楽に切り替えできれば便利ですね。

参考URL



Private　Sub　実行ボタン_Click()
　　　　dim　a　as　string
　　　　a　=　trim(me!場所)　&　"\MITUTBL.MDB"
　　　　If　Len(Dir(a))　=　0　Then　　'テーブルなし
　　　　　　Msgbox　"テーブルがありません"
　　　　ElseIf　リンク再設定(me)　=　0　Then
　　　　　　Msgbox　"リンクのエラーです"
　　　　End　If
End　Sub


Public　Function　リンク再設定(FRM　As　Form)　As　Integer
　　On　Error　GoTo　AZ　
　　リンク再設定　=　0
　　Dim　DBS　As　Database
　　Dim　CON　As　String
　　Dim　TDF　As　TableDef
　　Dim　TDRIVE　As　String
　　Dim　i　As　Integer
　　Set　DBS　=　CurrentDb
　'-リンクの削除--------------------------------------
　　On　Error　Resume　Next
　　DBS.TableDefs.DELETE　"共通情報"
　　DBS.TableDefs.DELETE　"得意先マスタ"
　'-リンク追加--------------------------------------
　　On　Error　GoTo　AZ
　　TDRIVE　=　Trim(FRM!場所)
　　CON　=　";DATABASE="　&　TDRIVE　&　"\MITUTBL.mdb"
　'共通情報テーブルのリンク
　　Set　TDF　=　DBS.CreateTableDef("共通情報")
　　TDF.Connect　=　CON
　　TDF.SourceTableName　=　"共通情報"
　　DBS.TableDefs.Append　TDF
　'得意先マスタのリンク
　　Set　TDF　=　DBS.CreateTableDef("得意先マスタ")
　　TDF.Connect　=　CON
　　TDF.SourceTableName　=　"得意先マスタ"
　　DBS.TableDefs.Append　TDF
　'------------------------------------------------
　　Set　DBS　=　Nothing
　　リンク再設定　=　1
AA:
　Exit　Function
AZ:
　MsgBox　"エラー："　&　Err　&　"　"　&　Err.Description
　Set　DBS　=　Nothing
　Resume　AA:
End　Function