MS ACCESSのVBA-ファイルの相対アドレス
- MS ACCESS(2013）で、フォームの画像フィールドにVBAで画像ファイルを指定して表示する方法についての質問です。
- 現在は絶対アドレス指定をしていますが、相対アドレス指定を試みましたが、失敗しています。
- 画像が同じドライブの同じフォルダ内のサブフォルダ内にありますが、データベースごと(その関連のフォルダごと）USBなどの外部デバイスに移動しようとしています。具体的な方法を教えてください。
- ベストアンサー
MS ACCESSのVBA-ファイルの相対アドレス
MS ACCESS(2013）で、フォームの画像フィールドにVBAで画像ファイルを指定して表示するようにしています。ただ、現在は絶対アドレス指定をしていますが、相対アドレス指定をこころみましたが、失敗しています。相対アドレス指定のやりかたが間違えているのかもしれません。方法をお教えください。(同じドライブの同じフォルダ内のサブフォルダ内に画像がありますが、データベースごと(その関連のフォルダごと）USBなどの外部ｆデバイスに移そうとしています。) 絶対アドレスのＶＢＡ Private Sub PlayerPicture_Set() '----画像表示(共通) On Error GoTo Err_PlayerPicture_Set If Me.PicTrue > 5 Then Me.PicTrue = 9 Me.IMG.Picture = "E:\My\DataBase\Music\Pic\小熊003.bmp" End If If Me.PicTrue = 1 Then Me.IMG.Picture = "E:\My\DataBase\Music\Pic\Player\" & Player & ".bmp" End If If Me.PicTrue = 2 Then Me.IMG.Picture = "E:\My\DataBase\Music\Pic\Player\" & Orchestra & ".bmp" End If 変更例 If Me.PicTrue = 1 Then Me.IMG.Picture = "E:\My\DataBase\Music\Pic\Player\" & Player & ".bmp" End If ---> If Me.PicTrue = 1 Then Me.IMG.Picture = "..\Pic\Player\" & Player & ".bmp" End If 相対アドレス化するために ..(コロン、コロン）で上位にいってましたが、もしかすると、間違いかと思い、..(上位もどり)を排除 "\Pic\Player\" & Player & ".bmp" してみましたが、それでもエラーでした。 なお、Ｍｕｓｉｃ．ｍｄｂ（ＡｃｃｅｓｓＤＢ）は E:\My\DataBase\Music の直下にあります。 以下省略。
- knightworld
- お礼率80% (20/25)
- その他MS Office製品
- 回答数3
- ありがとう数14
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
前の回答、文字化けしていますので、訂正です。 誤） Asusutasisiのプロパティでは相対アドレスは認識出来ません。 正） Accessのプロパティでは相対アドレスは認識出来ません。
その他の回答 (2)
- hatena1989
- ベストアンサー率87% (378/433)
Asusutasisiのプロパティでは相対アドレスは認識出来ません。 CurrentProject.Path でデータベースファイルのあるフォルダーのパスを取得出来ますので、 それを使えばいいでしょう。 If Me.PicTrue = 1 Then Me.IMG.Picture = CurrentProject.Path & "\Pic\Player\" & Player & ".bmp" End If
- papapa0427
- ベストアンサー率25% (371/1472)
＞Me.IMG.Picture = "..\Pic\Player\" & Player & ".bmp" を Me.IMG.Picture = "E:..\Pic\Player\" & Player & ".bmp" で駄目でしょうか？
関連するQ&A
- Access 97 VBAについて
Access VBAについて教えてください。 初心者ですが、レポートに表示されるテキストボックスの”項目名”と”内容”プロパティーに重複データ非表示にしています。そして、非表示となった部分に”〃”を表示するため別のテキストボックス、”隠しオブジェクト1”及び”隠しオブジェクト2”を配置しています。？？？にどんな記述が必要かわかりません。”項目名”だけであれば問題なく表示されるのですが”内容”についても同様に処理したいのです。 どうぞ宜しくお願いいたします。 Option Compare Database Option Explicit '値を保持するために外側に変数を定義します。 Dim varA As Variant --------------------------------------------------- Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer) If Me.項目名 = varA Then Me.隠しオブジェクト1.Visible = True Else Me.隠しオブジェクト1.Visible = False End If varA = Me.項目名 ？？？？ If Me.内容 = varA Then Me.隠しオブジェクト2.Visible = True Else Me.隠しオブジェクト2.Visible = False End If varA = Me.内容 End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでの画像ファイル名取得他
VBAについての質問です。 http://hp.vector.co.jp/authors/VA033788/kowaza.html#0158 上記をベースに、なんとかVBAを下記のように書き換えました。 Sub LoadPictures3() Dim Fnames As Variant Dim Fn As Variant Dim i As Integer Dim Pic As Picture Dim R As Range Dim R2 As Range Dim Pc As Integer Fnames = Application.GetOpenFilename("図(*.jpg;*.gif),*.jpg;*.gif", MultiSelect:=True) If TypeName(Fnames) = "Boolean" Then Exit Sub Application.ScreenUpdating = False '一枚目の貼付け位置 Set R = Range("B5") Set R2 = R.Offset(35) Pc = 0 For i = 1 To UBound(Fnames) Set Pic = ActiveSheet.Pictures.Insert(Fnames(i)) Select Case (i - 1) Mod 4 + 1 Case 1 Pc = Pc + 1 If Pc >= 2 Then ActiveSheet.HPageBreaks.Add R2 End If With R Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With Case 2 With R.Offset(0, 6) '一枚目に対する二枚目の相対位置 Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With Case 3 With R.Offset(18, 0) Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With Case 4 With R.Offset(18, 6) Pic.Left = .Left Pic.Top = .Top Pic.Width = 300 Pic.Height = 225 End With '次ページの相対位置 Set R = R.Offset(39) End Select Next Application.ScreenUpdating = True End Sub ここで、画像の上の位置（B5のセル位置の画像の場合、B4）に 元々の画像ファイル名を取得し、表記させたいのですが 調べた所、multiselect:=Trueで複数ファイルを選択するときに 画像名が図1、図2に変わっているようで、どうしていいかわかりません。 後、画像を300×225の「変倍」画像にしたいのですが どのようにすれば可能でしょうか？ 全くVBAの知識がなく、上のURLを参考に、単語を調べつつ書き換えている状態で、変数やらなんやらの指定・書き方等わかりません。 どなたかご教授願います。
- ベストアンサー
- オフィス系ソフト
- MSアクセス2010と2003
アクセスの帳票フォームで入力用チェックボックスが84個（ｃｋ1からck84）あります。表示データは10個程度ですが、このチェックマークの更新前処理で、同じ場所へのダブリが発生しないような処理をしています。フォームフッターにテキストボックスを84個配し（Text1～Text84）、Text1はCk1の合計を、Text2はCk2の合計を出すようにしておき、CK1の更新前処理に Select Case Me![Text1] Case "" If (Me![ck1]) = -1 Then MsgBox "Please wait" Cancel = True Me.Undo End If Case "-1" If (Me![ck1]) = -1 Then MsgBox "Already used." Cancel = True Me.Undo End If End Select またチェックマークを入れることにより、計算処理をして結果をチェックボックスの下に表示しているためme.Refreshを更新後処理に入れております。アクセス2003＋Office2003SP3では問題なく動きますが、アクセス2003＋Office2003SP1、アクセス2010+Office2010SP1では次のチェックボックスにチェックを入れるのに5～6秒程掛かります。（アクセス2003+OfficeSP3ではチェックマークをつけて次のチェックマークを付けるのに待ち時間はありません。）したがって使い物になりません。何か考えられることはありますでしょうか。
- ベストアンサー
- その他(データベース)
- アクセスVBA（先日の続きになります）
前回教えていただきました検索抽出のVBAですが、抽出がうまくできなくなってしまいました。 抽出条件を入力しているにもかかわらず、全部のデータが表示されてしまいます。 どこがまずいのかわかりましたら、ぜひ教えてください。 Private Sub btn_検索02_Click() Dim kensaku As String If Not Me![t_04] = "" Then kensaku = kensaku & _ "([舗装施行年度] Like '*" & Me![t_04] & "*') AND " If Not Me![t_05] = "" Then kensaku = kensaku & _ "([舗装工事名] Like '*" & Me![t_05] & "*') AND " If Not Me![t_06] = "" Then kensaku = kensaku & _ "([舗装区間01] Like '*" & Me![t_06] & "*') AND " If Not Me![t_07] = "" Then kensaku = kensaku & _ "([舗装区間02] Like '*" & Me![t_07] & "*') AND " If Not Me![t_08] = "" Then kensaku = kensaku & _ "([改良施行年度] Like '*" & Me![t_08] & "*') AND " If Not Me![t_09] = "" Then kensaku = kensaku & _ "([改良工事名] Like '*" & Me![t_09] & "*') AND " If Not Me![t_10] = "" Then kensaku = kensaku & _ "([改良区間01] Like '*" & Me![t_10] & "*') AND " If Not Me![t_11] = "" Then kensaku = kensaku & _ "([改良区間02] Like '*" & Me![t_11] & "*') AND " If Not Me![t_12] = "" Then kensaku = kensaku & _ "([台帳作図年度] Like '*" & Me![t_12] & "*') AND " If Not Me![t_13] = "" Then kensaku = kensaku & _ "([台帳調査名] Like '*" & Me![t_13] & "*') AND " If kensaku <> "" Then kensaku = Left(kensaku, Len(kensaku) - 5) DoCmd.OpenForm "検索結果", , , kensakum, acFormReadOnly DoCmd.Maximize DoCmd.Close acForm, Me.Name End If End Sub
- ベストアンサー
- オフィス系ソフト
- Access2000のＶＢＡについて
下記のプログラムだと挿入が可能になります。 Private Sub 削除_コマンド_Click() If IsNull(Me.社員コード) Then MsgBox ("社員コードが入力されていません") Else Dim strSQL As String strSQL = "INSERT INTO 社員情報テーブル(社員コード,作成日) " _ & " VALUES ('" & Me.社員コード & "', now());" DoCmd.RunSQL strSQL End If End Sub しかし、下記のプログラムだとinsert文の『Me.社員コード』で エラーが発生します。 エラーメッセージは 『メソッドまたはデータメンバが見つかりません』 と表示されます。 上と下とどう違うのでしょうか。 Private Sub 削除_コマンド_Click() If IsNull(Me.社員コード) Then MsgBox ("社員コードが入力されていません") Else Dim strSQL As String strSQL = "INSERT INTO 社員情報テーブル(社員コード,氏名(氏),作成日) " _ & " VALUES ('" & Me.社員コード & "','" & Me.氏名(氏) & "', now());" DoCmd.RunSQL strSQL End If End Sub
- ベストアンサー
- その他(データベース)
- アクセス２０００のレポートでイメージを表示させたいのですが
アクセス２０００でデータベースを作成しています。レポートについて分からないことがあるので教えてください。 ・ImageFileというフィールドにイメージファイルのフルパスを入力しておき、フォーム上のPictureを配置し、下記のようなコードを記述して、Pictureに、イメージファイルを読み込んで表示させています。 Private Sub Form_Current() If IsNull(Me.ImageFile) Then Me.イメージ.Picture = "d:\nonimage.jpg" Else: Me.イメージ.Picture = Me![ImageFile] End If End Sub ・同じような方法でレポートでイメージを印刷させることは出来ないでしょうか？ 尚、ImageFileはレコード毎に異なるものを使用しています。
- 締切済み
- オフィス系ソフト
- エクセルＶＢＡのMultipageの使い方について
MultipageにそれぞれImagecontrolを張り付けて エクセルで自動作成したマーカー付折れ線グラフを 表示させるマクロを書いてみたんですが 2Pageまでは、上手く動作するんですが3page目をクリックしても 全く反応しません。何がおかしいのかどなたかお分かりの方 ご教授下さい。 ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ Private Sub MultiPage1_Change() Application.ScreenUpdating = False Dim chartrange As Range Me.MultiPage1.Value = 0 ActiveSheet.Range("a8").CurrentRegion.Select Set chartrange = Selection Charts.Add ActiveChart.ChartType = xlLineMarkers ActiveChart.SetSourceData Source:=chartrange, PlotBy:=xlRows ActiveChart.Location where:=xlLocationAsObject, Name:="記録" Const graphimage2 As String = "C:\Users\user\Pictures\Graph.bmp" If ActiveSheet.ChartObjects.Count = 0 Then Exit Sub ActiveSheet.ChartObjects(1).Chart.Export graphimage2 If Len(Dir(graphimage2)) > 0 Then With Image1 .PictureSizeMode = fmPictureSizeModeStretch .PictureAlignment = fmPictureAlignmentCenter .BorderStyle = fmBorderStyleNone .Picture = LoadPicture(graphimage2) End With Kill graphimage2 End If ActiveSheet.ChartObjects.Delete Me.MultiPage1.Value = 1 ActiveSheet.Range("a11").CurrentRegion.Select Set chartrange = Selection Charts.Add ActiveChart.ChartType = xlLineMarkers ActiveChart.SetSourceData Source:=chartrange, PlotBy:=xlRows ActiveChart.Location where:=xlLocationAsObject, Name:="記録" Const graphimage3 As String = "C:\Users\user\Pictures\Graph.bmp" If ActiveSheet.ChartObjects.Count = 0 Then Exit Sub ActiveSheet.ChartObjects(1).Chart.Export graphimage2 If Len(Dir(graphimage3)) > 0 Then With Image2 .PictureSizeMode = fmPictureSizeModeStretch .PictureAlignment = fmPictureAlignmentCenter .BorderStyle = fmBorderStyleNone .Picture = LoadPicture(graphimage3) End With Kill graphimage3 ActiveSheet.ChartObjects.Delete End If Me.MultiPage1.Value = 2 ActiveSheet.Range("a14").CurrentRegion.Select Set chartrange = Selection Charts.Add ActiveChart.ChartType = xlLineMarkers ActiveChart.SetSourceData Source:=chartrange, PlotBy:=xlRows ActiveChart.Location where:=xlLocationAsObject, Name:="記録" Const graphimage4 As String = "C:\Users\user\Pictures\Graph.bmp" If ActiveSheet.ChartObjects.Count = 0 Then Exit Sub ActiveSheet.ChartObjects(1).Chart.Export graphimage4 If Len(Dir(graphimage4)) > 0 Then With Image3 .PictureSizeMode = fmPictureSizeModeStretch .PictureAlignment = fmpictueralignmentcenter .BorderStyle = fmBorderStyleNone .Picture = LoadPicture(grphimage4) End With Kill graphimage4 End If ActiveSheet.ChartObjects.Delete Application.ScreenUpdating = True End Sub
- 締切済み
- Visual Basic
- Access VBA
Access2003を使用しています。 単純な質問かもしれませんがよろしくお願いします。 ログイン画面を作成しておりログイン自体はできたのですが、ログインしたときに ログイン画面を自動的に閉じたいのですが、うまくいきません。 現在の仕様では、ログイン画面(frm_ログイン)とメイン画面(frm_main)があり ログインに成功するとメイン画面が開くようになっています。 ーー以下VBAコードーー Private Sub rogin_Click() Dim a If IsNull(Me.[UserName]) Then MsgBox "IDが未入力です" Me.[UserName].SetFocus ElseIf IsNull(Me.[password]) Then MsgBox "パスワードが未入力です" Me.[password].SetFocus Else a = DLookup("パスワード", "tbl_ユーザー", "ユーザー名='" & Me.[UserName] & "'") If IsNull(a) Then MsgBox "該当する ユーザー名 は存在しません" Me.[UserName].SetFocus ElseIf StrComp(a, Me.[password], vbBinaryCompare) = 0 Then On Error GoTo Err_rogin_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_main" DoCmd.OpenForm stDocName, , , stLinkCriteria Else MsgBox "パスワードが違います" Me.[password].SetFocus End If End If Exit_rogin_Click: Exit Sub Err_rogin_Click: MsgBox Err.Description Resume Exit_rogin_Click End Sub ーー以上ーー 長くなって申し訳ないのですが、どのようにすればログイン後にログイン画面（frm_ログイン)を閉じるようにできるのでしょうか？ よろしくお願いします。
- ベストアンサー
- その他（プログラミング・開発）
- EXCEL VBA
Excel VBAで アンケート集計をしたいと思い、プログラムを作ったのですが、J列までは入力がうまくいくのですが、K列にデータを入れて次の行にデータを入れると もともと存在していたＫれつのデータが消えてしまします。 どう修正すれば ちゃんとデータが残ってくれるのでしょうか？ 誰か教えてください Option Explicit Private Sub UserForm_Initialize() Dim チェックボックス As Control With cboBlood .AddItem "A型" .AddItem "B型" .AddItem "O型" .AddItem "AB型" End With cboBlood.ListIndex = -1 txtNo.Value = WorksheetFunction.Max( _ [Database].Resize(, 1)) + 1 txtNo.Enabled = False txtName.Text = "" optMale.Value = True txtAge.Value = 0 For Each チェックボックス In fraOS.Controls チェックボックス.Value = False Next txtName.SetFocus End Sub Private Sub cmdEntry_Click() Dim 行 As Long Dim 確認 As Integer 確認 = MsgBox("データを登録します。" _ & "よろしいですか?", vbYesNo) If 確認 <> vbYes Then Exit Sub 行 = [Database].Rows.Count + 1 [Database].Cells(行 - 1, 1).EntireRow.Insert [Database].Offset(行 - 1).Resize(1).Copy _ [Database].Cells(行 - 1, 1) [Database].Offset(行 - 1).Resize(1).ClearContents [Database].Cells(行, 1) = txtNo.Value [Database].Cells(行, 2) = txtName.Text If optMale.Value = True Then [Database].Cells(行, 3) = "男性" Else [Database].Cells(行, 3) = "女性" End If [Database].Cells(行, 4) = cboBlood.Text [Database].Cells(行, 5) = txtAge.Value If chkWin.Value = True Then _ [Database].Cells(行, 6) = "○" If chkMac.Value = True Then _ [Database].Cells(行, 7) = "○" If chkLinux.Value = True Then _ [Database].Cells(行, 8) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 9) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 10) = "○" Unload frmNew End Sub Private Sub cmdCancel_Click() Unload frmNew End Sub
- ベストアンサー
- その他(データベース)
- EXCEL VBA
Excel VBAで アンケート集計をしたいと思い、プログラムを作ったのですが、J列までは入力がうまくいくのですが、K列にデータを入れて次の行にデータを入れると もともと存在していたＫれつのデータが消えてしまします。 どう修正すれば ちゃんとデータが残ってくれるのでしょうか？ 誰か教えてください Option Explicit Private Sub UserForm_Initialize() Dim チェックボックス As Control With cboBlood .AddItem "A型" .AddItem "B型" .AddItem "O型" .AddItem "AB型" End With cboBlood.ListIndex = -1 txtNo.Value = WorksheetFunction.Max( _ [Database].Resize(, 1)) + 1 txtNo.Enabled = False txtName.Text = "" optMale.Value = True txtAge.Value = 0 For Each チェックボックス In fraOS.Controls チェックボックス.Value = False Next txtName.SetFocus End Sub Private Sub cmdEntry_Click() Dim 行 As Long Dim 確認 As Integer 確認 = MsgBox("データを登録します。" _ & "よろしいですか?", vbYesNo) If 確認 <> vbYes Then Exit Sub 行 = [Database].Rows.Count + 1 [Database].Cells(行 - 1, 1).EntireRow.Insert [Database].Offset(行 - 1).Resize(1).Copy _ [Database].Cells(行 - 1, 1) [Database].Offset(行 - 1).Resize(1).ClearContents [Database].Cells(行, 1) = txtNo.Value [Database].Cells(行, 2) = txtName.Text If optMale.Value = True Then [Database].Cells(行, 3) = "男性" Else [Database].Cells(行, 3) = "女性" End If [Database].Cells(行, 4) = cboBlood.Text [Database].Cells(行, 5) = txtAge.Value If chkWin.Value = True Then _ [Database].Cells(行, 6) = "○" If chkMac.Value = True Then _ [Database].Cells(行, 7) = "○" If chkLinux.Value = True Then _ [Database].Cells(行, 8) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 9) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 10) = "○" Unload frmNew End Sub Private Sub cmdCancel_Click() Unload frmNew End Sub
- ベストアンサー
- その他(データベース)
お礼
了解しました MS OfficeはカレントディレクトリがWeb対応されていないと読めました。 要するに、以下のような処理が必要かと。 Dim lnkPath As String lnkPath = CurrentProject.Path ・・・・ If Me.PicTrue = 2 Then Me.IMG.Picture = lnkPath & "\Pic\Player\" & ComposerName & ".bmp" End If (以下省略) なお、投稿時点では\=円マークでしたが、フォント設定かバックスラッシュに文字化けしてます。 Excelでは、Projectではなく,WorkSheetに該当するのでしょうが、MSの構成からいって、原則、マイドキュメントやTempのデフォルトディレクトリを指し示すようですね。 上記構文でエラーなく対応できました。 最近、MS Access Clubがどういう理由か閉鎖されてしまい、サポートに不満もありますが、素人には皆様の知見を収集するしか対策なしです。 今後とも、恥ずかしい質問をご披露すること、お許しください。