主窗体更改如下:
Private Sub Command3_Click() 'UPLOAD
Dim fso As New FileSystemObject
Dim filePath As String
Dim fileName
filePath = GetF(True)
If filePath = "" Then Exit Sub
fileName = Mid(filePath, InStrRev(filePath, "\") + 1) '获得文件路径中的文件名部分
fileName = Mid(fileName, 1, InStrRev(fileName, ".") - 1) '去掉文件后缀名
If Right(filePath, 4) <> ".jpg" Then Exit Sub
fso.CopyFile filePath, CurrentProject.Path & "\Pic\" & fileName & ".jpg", True '把图片从某地方复制到目标文件夹
Me.PIC2.Picture = CurrentProject.Path & "\Pic\" & fileName & ".jpg" '把复制过来的图片在第一个图片控件中显示
Me.BOMlist.Controls("MechModle") = fileName '把文件名存储到TRmodel字段
Set fso = Nothing
End Sub
Private Sub Command44_Click() '上传图片
Dim fso As New FileSystemObject
Dim filePath As String
Dim fileName
filePath = GetF(True)
If filePath = "" Then Exit Sub
fileName = Mid(filePath, InStrRev(filePath, "\") + 1) '获得文件路径中的文件名部分
fileName = Mid(fileName, 1, InStrRev(fileName, ".") - 1) '去掉文件后缀名
If Right(filePath, 4) <> ".jpg" Then Exit Sub
fso.CopyFile filePath, CurrentProject.Path & "\Pic\" & fileName & ".jpg", True '把图片从某地方复制到目标文件夹
Me.ProductP1.Picture = CurrentProject.Path & "\Pic\" & fileName & ".jpg" '把复制过来的图片在第一个图片控件中显示
Me.BOMlist.Controls("TRmodel") = fileName '把文件名存储到TRmodel字段
Set fso = Nothing
End Sub
子窗体更改如下:
Private Sub Form_Current()
Dim frm As Form_BOM_P1
Dim fso As New FileSystemObject
Dim p As String
Call SetParentFormctrls(Me.Form)
Set frm = Me.Parent.Form
p = CurrentProject.Path & "\Pic\" & Me.TRmodel.Value & ".jpg"
If fso.FileExists(p) = True Then
frm.ProductP1.Picture = p
Else
Me.Refresh
'MsgBox "找不到图片"
End If
p = CurrentProject.Path & "\Pic\" & Me.MechModle.Value & ".jpg" 'MechModl
If fso.FileExists(p) = True Then
frm.PIC2.Picture = p
Else
Me.Refresh
'MsgBox "找不到图片"
End If
End Sub
