怎么用VBA在EXCEL表格中检索对应的产品编号的产品图片,求指教
发布网友
发布时间:2022-04-30 07:59
我来回答
共3个回答
热心网友
时间:2023-10-21 12:49
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Myname As String
Dim Mypath As String
Dim Picname() As String
On Error Resume Next
Mypath = "C:\Users\Administrator\Pictures\图片\"
If Target.Count = 1 And Target.Column = 1 Then
Myname = Dir(Mypath & Target.Value & "*.jpg", 0)
i = 0
For k = 0 To 10
ActiveSheet.Shapes("B" & Target.Row & k).Delete
If Err.Number = 440 Then
Exit For
End If
Next k
Do While Myname <> ""
ReDim Preserve Picname(i)
Picname(i) = Myname
i = i + 1
Myname = Dir
Loop
For j = 0 To i - 1
With ActiveSheet.Pictures.Insert(Mypath & Picname(j))
.Top = Target.Offset(0, 1).Top
.Left = Target.Offset(0, 1).Left + j * Target.Offset(0, 1).Width / (i)
.ShapeRange.LockAspectRatio = msoFalse
.Height = Target.Offset(0, 1).Height
.Width = Target.Offset(0, 1).Width / (i)
.Name = "B" & Target.Row & j
End With
Next j
End If
End Sub
在你使用的表格的CHANGE事件,添加上面代码看看是不是符合要求。
热心网友
时间:2023-10-21 12:49
Sheet4.Pictures.Insert ThisWorkbook.Path & "\照片\" & Range("C3") & ".jpg"
给邮箱发实例给你,我做的全是这个改的。
热心网友
时间:2023-10-21 12:49
http://www.blue1000.com/bkhtml/2006-12/49398.htm
参考一下
热心网友
时间:2023-10-21 12:49
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Myname As String
Dim Mypath As String
Dim Picname() As String
On Error Resume Next
Mypath = "C:\Users\Administrator\Pictures\图片\"
If Target.Count = 1 And Target.Column = 1 Then
Myname = Dir(Mypath & Target.Value & "*.jpg", 0)
i = 0
For k = 0 To 10
ActiveSheet.Shapes("B" & Target.Row & k).Delete
If Err.Number = 440 Then
Exit For
End If
Next k
Do While Myname <> ""
ReDim Preserve Picname(i)
Picname(i) = Myname
i = i + 1
Myname = Dir
Loop
For j = 0 To i - 1
With ActiveSheet.Pictures.Insert(Mypath & Picname(j))
.Top = Target.Offset(0, 1).Top
.Left = Target.Offset(0, 1).Left + j * Target.Offset(0, 1).Width / (i)
.ShapeRange.LockAspectRatio = msoFalse
.Height = Target.Offset(0, 1).Height
.Width = Target.Offset(0, 1).Width / (i)
.Name = "B" & Target.Row & j
End With
Next j
End If
End Sub
在你使用的表格的CHANGE事件,添加上面代码看看是不是符合要求。
热心网友
时间:2023-10-21 12:49
Sheet4.Pictures.Insert ThisWorkbook.Path & "\照片\" & Range("C3") & ".jpg"
给邮箱发实例给你,我做的全是这个改的。
热心网友
时间:2023-10-21 12:49
http://www.blue1000.com/bkhtml/2006-12/49398.htm
参考一下