| |
YU-TANG さん 遅くなりました ありがとうございます m(_ _)m
>その MDB の作りに依存するので、第三者には想定しようがないです。
ですね
自分自身でもなんか ？ な Ｑ だなと感じていました
そんな中,書き込み頂きましてありがとうございました
>おそらく最良のアドバイスは、しっかりテストしてください、
>ということになるでしょう。
了解です
ありがとうございました
MDEの動作について漠然とした理解しかありませんでした
アドバイスを頂いて調べてみましたが
ht tp://support.microsoft.com/kb/882282/ja
MDB ファイルは、フォーム、レポート、モジュールなどの編集や削除を行うことが
できますが、MDE ファイルに変換することによって、実行のみ可能で編集できない
2007 help
VBA コードは、コンパイルされて .accde ファイルに組み込まれユーザーが
VBA コードを参照したり編集はできません。accde ファイルのユーザーは、
フォームやレポートのデザインを変更出来ない
ぐらいしか見つからず
調査前と調査後 知識のレベルはほとんど変わりませんでした
こんなレベルでの考えで、MDEでは
デザイン変更できない → 列移動、列幅変更できない 保存できない
と思い込んでいました
>フォームを閉じるときに設定を退避して、開くときに復元すればいいだけです。
>MDE のように振舞うインターフェイスが欲しいなら、すなおに MDE を
>使ったほうがいいように思います。
ありがとうございます、MDEで出来るなら是非そうしたいです
で、
頂いたアドバイスでチャレンジしてみましたがうまくできませんでした
下記アドバイス頂けると助かります
よろしくお願いいたします
環境 XP ac2003
本来は、データシート形式のサブフォームのレイアウトを保存したかったのですが、まずは、テーブルのレイアウト保存で試してみました
Ｑ１
'レイアウトセット処理 Sub set_layout()
を実行してもうまく動作しません
どう修正すればいいでしょうか
不具合状況
・データシートレイアウト保存テーブル作成 Sub make_tbl_layout()
を実行し、レイアウト保存用空テーブルt_tbl_layout作成
・レイアウト取得処理 Sub get_layout()
を実行し、レイアウト保存テーブルt_tbl_layoutにレイアウト情報取得
t_tbl_layout レイアウト変更した情報
id Column_Orde Control_Source Column_Width
0 2 hoge2 1350
1 1 hoge1 765
2 3 hoge3 3870
3 12 hoge12 1065
4 13 hoge13 1065
5 14 hoge14 1065
6 15 hoge15 1065
7 16 hoge16 1065
t_tbl_layout 初期レイアウト情報
id Column_Orde Control_Source Column_Width
0 1 hoge1 -1
1 2 hoge2 -1
2 3 hoge3 -1
3 4 hoge4 -1
4 5 hoge5 -1
5 6 hoge6 -1
6 7 hoge7 -1
7 8 hoge8 -1
t_tbl_layoutのＤＴを初期レイアウト情報に書き換えて
レイアウトセット処理 Sub set_layout()
を実行してみましたが、レイアウトを戻すことができませんでした
また、エラーも生じません
この辺の処理、理解が出来ていません
Ｑ２
サブフォームのレイアウト取得する場合ですが
動作的には
メインフォームの閉じるボタンで
DoCmd.Close acForm, Me.Name, acSaveYes
'Application.Quit
としているので
サブフォーム自体のレイアウトは保存されています
For i = 0 To FRM.Controls.Count - 1
とすると、ラベル情報も取得してしまい
いまいち処理がすっきりしないような気がしています
また、ラベルとテキストボックスの切り分け処理方法が
いまいち浮かびません
もう少しいい方法が有るような気がしています
がどうでしょう
ちなみに、このサブフォームのレコードソースは
ＳＱＬ直書としています
他
レコード検索等はよく行っているのですが
追加、削除はあまりやったことがありません
エラー処理等、注意事項等ありましたら
合わせてご教示頂けると助かります
よろしくお願いいたします
'データシートレイアウト保存テーブル作成
Sub make_tbl_layout()
Dim db As Database
Dim Newtbl As TableDef
On Error Resume Next
DoCmd.DeleteObject acTable, "t_tbl_layout"
On Error GoTo 0
Set db = CurrentDb
Set Newtbl = db.CreateTableDef("t_tbl_layout")
With Newtbl
'indexの作成の仕方未調査につき下記はindexとはしていない
.Fields.Append .CreateField("id", dbInteger)
.Fields.Append .CreateField("Column_Orde", dbInteger)
.Fields.Append .CreateField("Control_Source", dbText, 50)
.Fields.Append .CreateField("Column_Width", dbInteger)
End With
db.TableDefs.Append Newtbl
End Sub
'レイアウト取得処理
Sub get_layout()
Dim FRM As Form
Dim CTL As Control
Dim i As Integer
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
'レイアウトDT削除
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM t_tbl_layout"
DoCmd.SetWarnings True
'レイアウト取得テーブルを開く場合
DoCmd.OpenTable "Sheet1"
Set FRM = Screen.ActiveDatasheet
'レイアウト取得フォームを開く場合
'DoCmd.OpenForm "MF01_JOB選択F"
'Set FRM = Forms("MF01_JOB選択F").Controls("T02_PJ_DT").Form
'では、データ形式のサブフォームのラベルも
'For Each CTL In FRM.Controls
' Debug.Print CTL.ColumnOrder & " ： " & CTL.ControlSource & " ： " & CTL.ColumnWidth
'Next CTL
'レイアウト取得
On Error Resume Next
For i = 0 To FRM.Controls.Count - 1
'Debug.Print i & "：" & FRM.Controls.Item(i).ColumnOrder & "：" & _
FRM.Controls.Item(i).ControlSource & "：" & FRM.Controls.Item(i).ColumnWidth
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open "t_tbl_layout", cn, adOpenKeyset, adLockOptimistic
rs.AddNew
rs.Fields(0).Value = i
rs.Fields(1).Value = FRM.Controls.Item(i).ColumnOrder '指定並べ替え
rs.Fields(2).Value = FRM.Controls.Item(i).ControlSource 'フィールド名
rs.Fields(3).Value = FRM.Controls.Item(i).ColumnWidth '列幅
rs.Update
Next
On Error GoTo 0
DoCmd.Close acTable, "Sheet1"
'DoCmd.Close acForm, "MF01_JOB選択F"
Set CTL = Nothing
Set FRM = Nothing
End Sub
'レイアウトセット処理
Sub set_layout()
Dim FRM As Form
Dim CTL As Control
Dim i As Integer
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
'レイアウト取得テーブルを開く
DoCmd.OpenTable "Sheet1"
Set FRM = Screen.ActiveDatasheet
'レイアウトセット
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open "t_tbl_layout", cn, adOpenKeyset, adLockOptimistic
rs.MoveFirst
Do Until rs.EOF
'Debug.Print rs.Fields.Item(1).Value & "：" & rs.Fields.Item(2).Value & "：" & rs.Fields.Item(3).Value
FRM.Controls.Item(i).ColumnOrder = rs.Fields.Item(1).Value '指定並べ替え
FRM.Controls.Item(i).ColumnWidth = rs.Fields.Item(3).Value '列幅
rs.MoveNext
Loop
'On Error GoTo 0
DoCmd.Save acTable, "Sheet1"
Set CTL = Nothing
Set FRM = Nothing
End Sub
|
|
pon
- 10/6/10(木) 15:13 -
![[未読]](./data/access/image/read_icon.gif){kind=icon}
