前提・実現したいこと
他ACCESSのレポート余白を変更する機能を実現したい。
変更したいACCESSのパスを参照し、該当のレポート名を入力して
その余白を設定した値に更新する構想。
【テーブル】WORKTBL_YOHAKU_HENKO
【フォーム】frm_yohaku_henko【サブフォーム】sub_yohaku_henko
発生している問題・エラーメッセージ
VBA
1DoCmd.OpenReport ("txt_repoto_mei"), acViewDesign, , , acHidden
実行時エラー'2103':
プロパティシートまたはマクロで指定したレポート名'txt_repoto_mei'が正しくないか、
または存在しないレポートを参照しています。
2019/8/7追加修正
VBA
1OtrerDB.DoCmd.OpenReport sub_yohaku_henko.txt_repoto_mei.Value, acViewDesign, , , acHidden
コンパイルエラー:
メソッドまたはデータメンバーが見つかりません。
(サブフォームのtxt_repotoにあるレポート名を取得できていない?
他ACCESSでtxt_report_meiという項目がないから?
他ACCESSのレポート名はサブフォームのレポート名と同じであることを確認。)
該当のソースコード
VBA
1'////////////////////////////////////////////////////////// 2' 3' 参照ボタンクリック時処理 4' 5'////////////////////////////////////////////////////////// 6Private Sub cmd_s_Click() 7Dim dlg As Object, boolResult As Boolean 8'オブジェクト変数にFileDialogオブジェクトを代入 9Set dlg = Application.FileDialog(msoFileDialogOpen) 10'FileDialogオブジェクトの各種プロパティを設定 11With dlg 12 .AllowMultiSelect = False 13 .FilterIndex = 3 14 .Title = "ファイルを開くダイアログボックスサンプル" 15 .ButtonName = "オープン" 16 17End With 18'[ファイルを開く]ダイアログボックスを表示する 19boolResult = dlg.Show 20 If boolResult Then 21 MsgBox "ファイル「" & dlg.SelectedItems(1) & "」が選択されました。" 22 txt_s = dlg.SelectedItems(1) 23 Else 24 '[キャンセル]ボタンが押された場合の処理 25 MsgBox "[キャンセル]ボタンが押されました。" 26 End If 27 28End Sub 29 30'////////////////////////////////////////////////////////// 31' 32' 更新ボタンクリック時処理 33' 34'////////////////////////////////////////////////////////// 35Private Sub cmd_k_Click() 36 37'モジュール呼び出し 38'call ChangeProperty 39 40DoCmd.OpenReport ("txt_repoto_mei"), acViewDesign, , , acHidden 41'余白の値を変更する 42With Reports(txt_repoto_mei).Printer 43.DefaultSize = False 44.LeftMargin = CDec("WORKTBL_YOHAKU_HENKO.hidari_yohaku") 45.RightMargin = CDec("WORKTBL_WORKTBL_YOHAKU_HENKO.migi_yohaku") 46End With 47 48DoCmd.Close acReport, ("txt_repoto_mei"), acSaveYes 49End Sub
2019/8/7追加修正
VBA
1'////////////////////////////////////////////////////////// 2' 3' 更新ボタンクリック時処理 4' 5'////////////////////////////////////////////////////////// 6Private Sub cmd_k_Click() 7On Error GoTo Err_Proc 8 9Dim strDBPath As String 10Dim OtrerDB As Object 11'参照パスを格納 12strDBPath = txt_s 13 14Set acApp = New Access.Application 15 acApp.Visible = True 16 acApp.OpenCurrentDatabase strDBPath 17 OtrerDB = acApp.OpenCurrentDatabase(strDBPath) 18 19OtrerDB.DoCmd.OpenReport sub_yohaku_henko.txt_repoto_mei.Value, acViewDesign, , , acHidden 20 21Dim prtFirst As Printer 22 23Set prtFirst = Reports(txt_repoto_mei).Printers(0) 24 25With prtFirst 26.DefaultSize = False 27.LeftMargin = CDec("WORKTBL_YOHAKU_HENKO.hidari_yohaku") 28.RightMargin = CDec("WORKTBL_WORKTBL_YOHAKU_HENKO.migi_yohaku") 29End With 30 31DoCmd.Close acReport, ("txt_repoto_mei"), acSaveYes 32 33Exit_Proc: 34 Exit Sub 35 36Err_Proc: 37 MsgBox Err.Description 38 Resume Exit_Proc 39End Sub
試したこと
モジュールで他ACCESSを参照できれば進展しそうだが、モジュールの呼び出しがうまくいかない。
VBA
1Function ChangeProperty(strDbName As String, strPropName As String, _ 2 varPropType As Variant, varPropValue As Variant) _ 3 As Integer 4 5 Dim dbs As DAO.Database, prp As Variant 6 Dim mdbName As String 7 Const conPropNotFoundError = 3270 8 9 mdbName = strDbName ' フルパス【例:SetChgProperty ("C:\accessshift\シフト.mdb")】 10 Set dbs = DBEngine.Workspaces(0).OpenDatabase(mdbName) 11 12 On Error GoTo Change_Err 13 dbs.Properties(strPropName) = varPropValue 14 ChangeProperty = True 15 16Change_Exit: 17 Exit Function 18 19Change_Err: 20 If Err = conPropNotFoundError Then 21 ' プロパティが見つから無い場合は作成する 22 Set prp = dbs.CreateProperty(strPropName, _ 23 varPropType, varPropValue) 24 dbs.Properties.Append prp 25 Resume Next 26 Else 27 ' 認識できないエラー 28 ChangeProperty = False 29 Resume Change_Exit 30 End If 31End Function 32
補足情報(FW/ツールのバージョンなど)
Windows10、ACCESS2016
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2019/08/06 02:51