象這樣的結果能滿足你的需要嘛？

這是我幾年前學Access程式設計花了很長時間才實現的：

我下面的程式碼實現：

1）插入圖片可以自由選擇圖片

2）並且自動將所選擇的圖片集中儲存在你指定的資料夾，自動命名

為了你能順利實現，我截個設計狀態下的圖，以及對圖片顯示的控制元件選擇（關鍵）

注意：

1）實際圖片是儲存在 文字框 [圖片名稱]中，包括路徑和名稱（連線你的表）

2）插入過程是將圖片插入到文字框

3）透過一個重新整理及呈現將文字框內的圖片顯示在圖片框中

4）圖片框的控制元件應選擇 “影象”，既不是繫結物件，也不是非繫結物件

程式碼如下：

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102Private Sub CmdInimage_Click() "插入圖片按鈕功能 Dim FileName As String Dim result As Integer Dim strMsg As String Dim rs As String Dim rs1 As String Dim targetfile, targetpath, strfilename, strfilepath As String rs1 = Me.款號 & "_"If Me.Lock = -1 Then MsgBox "記錄已稽核，無法進行修改"Else If IsNull(Me.款號) = False Then "If IsNull(Me.圖片名稱) = True Then With Application.FileDialog(3) .Title = "選擇需要上傳的圖片" .Filters.Add "所有檔案", "*.*" .Filters.Add "JPEG圖片", "*.jpg" .Filters.Add "BMP圖片", "*.bmp" .Filters.Add "PNG圖片", "*.png" .FilterIndex = 2 .AllowMultiSelect = True .InitialFileName = CurrentProject.Path If .show = True Then targetfile = .SelectedItems(1) "targetpath = .InitialFileName End If End With With Application.FileDialog(2) "msoFileDialogFilePicker .Title = "將圖片上傳到指定資料夾" .InitialFileName = "\\192.168.1.10\hd_fty\Product files\Image\" .AllowMultiSelect = False .InitialFileName = rs1 If .show = True Then strfilename = Replace(targetfile, (Left(targetfile, InStrRev(targetfile, "\"))), "") targetpath = .SelectedItems(1) End If End With FileCopy targetfile, targetpath & strfilename Me.圖片名稱 = targetpath & strfilename Call Form_Current "Else " Me.圖片名稱 = "" " Me.ImgPMC.Picture = "" "End If Else MsgBox "親，請先輸入款號，再進行其它操作哦。" Me.款號.SetFocus End If End IfEnd Sub Private Sub Form_Current() "成為當前記錄時顯現圖片 " 如果圖片存在，顯示當前圖片． " 如果圖片檔案不存在,或檔名為空，在錯誤資訊 " 標籤上顯示適當的資訊． Dim res As Boolean Dim fName As String Dim Path As String Path = CurrentProject.Path On Error Resume Next If IsNull(Me!圖片名稱) = False Then res = IsRelative(Me!圖片名稱) fName = Me![圖片名稱] If (res = True) Then fName = Path & "\" & fName End If Me![ImgPMC].Picture = fName Me.PaintPalette = Me![ImgPMC].ObjectPalette "Me.CmdInimage.Enabled = False Else If (Me![ImgPMC].Picture <> fName) Then Me![ImgPMC].Picture = "" End If End If Me.稽核人.Enabled = False "按鍵是插入圖片還是刪除圖片 If IsNull(Me.圖片名稱) = True Then Me.ImgPMC.Picture = "" Me.CmdInimage.Enabled = True Me.CmdDelectimage.Enabled = False Else Me.CmdInimage.Enabled = False Me.CmdDelectimage.Enabled = True End If If Me.Lock = -1 Then Me.AllowEdits = False Me.fsubHeader.Form.AddMenu "重置(&R)", 6 Else Me.AllowEdits = True Me.fsubHeader.Form.AddMenu "稽核(&M)", 6 End If End Sub