Question

excel高手请进-用VBA输入编号图片自动显示在excel中

Private Sub CommandButton5_Click() '单击命令按钮
Dim rng As Range, ML, MT, MW, MH, shp As Shape, n%, Myr&, i&
On Error Resume Next
Sheet1.Activate
For Each shp In ActiveSheet.Shapes
If shp.Type = msoAutoShape Then
shp.Delete
End If
Next
Myr = [a1].CurrentRegion.Rows.Count

For i = 2 To Myr Step 1
Set rng = Cells(i, 3).Resize(1, 1)
With rng
ML = .Left
MT = .Top
MW = .Width
MH = .Height
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
Selection.ShapeRange.Fill.UserPicture _
ThisWorkbook.Path & "\" & Cells(i, 2).Value & ".jpg" '照片名字单元格

End With
Next
[a1].Select
If Err.Number <> 0 Then Err.Clear: On Error GoTo 0
End Sub
这个代码只能表格和图片在同一个文件夹内，我想把表格放在E:\
然后图片放在E:\新图片 里面。上面的代码要怎么改！谢谢！

Answer 1

Private Sub CommandButton5_Click() '单击命令按钮
Dim rng As Range, ML, MT, MW, MH, shp As Shape, n%, Myr&, i&

On Error Resume Next

Sheet1.Activate

For Each shp In ActiveSheet.Shapes

If shp.Type = msoAutoShape Then

shp.Delete

End If

Next

Myr = [a1].CurrentRegion.Rows.Count

For i = 2 To Myr Step 1

Set rng = Cells(i, 3).Resize(1, 1)

With rng

ML = .Left

MT = .Top

MW = .Width

MH = .Height

ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select

Selection.ShapeRange.Fill.UserPicture _

"E:\新图片\" & Cells(i, 2).Value & ".jpg" '照片名字单元格

End With

Next

[a1].Select

If Err.Number <> 0 Then Err.Clear: On Error GoTo 0

End Sub

表格放哪里无所谓

Answer 2

把ThisWorkbook.Path & "\" & Cells(i, 2).Value & ".jpg" '照片名字单元格

改成"E:\新图片\" & Cells(i, 2).Value & ".jpg" '照片名字单元格

试试