Question

EXCEL用VBA定位图片插入位置错误

插入一张图，定位到指定位置，但实际显示不在指定位置

ashape.copy
asheet.activate
activesheet.paste
with selection
.top=cells(80,2).top
.left=cells(80,2).left
end with

他应该把图片插入到B80这个格子，但是实际插入的却是B78单元格，求指导

Answer 1

可能是你在后面的语句中对图片尺寸做了调整，导致位置发生变化。应该先调整尺寸再定位。

追问

不是，调整大小是对右边和下边改变，对上边和左边不发生变化的，不是调整尺寸的问题

Answer 2

EXCEL直接插入图片
可能会出现这个问题
使用以下代码，或许可以满足你的要求
Sub 插入制品图片()
On Error Resume Next
Dim strX As String
strX = "\\172.24.242.11\manufacture\形状示意图\" & Range("C2").Value & ".bmp"
If Dir(strX) = "" Then
Sheet1.Image1.Picture = LoadPicture
Exit Sub
Else
Sheet1.Image1.Picture = LoadPicture(strX)
Sheet1.Image1.PictureSizeMode = fmPictureSizeModeStretch
Sheet1.Image1.BackStyle = fmBackStyleTransparent
End If
On Error GoTo 0
End Sub

不清楚的，请追问

追问

不是插入图片，是复制图片，从SHEET2复制到SHEET1

Answer 3

ashape.copy
asheet.activate
asheet.cells(80,2).select
activesheet.paste

粘贴时会放在你选择单元格位置

追问

但实际不是，实际是黏贴在B78，同时发现如果我缩小行距，那么图黏贴在B82
也就是说他貌似不是跟着单元格走，是在固定位置

追答

   ipath = "C:\jpg"
    maxrow=1000
    With ActiveSheet
    i = 0
10  i = i + 1
    if i> maxrow then exit sub
    If .Cells(i, 1) = "" Then goto 10
    .Rows(i + 1).Insert
    .Cells(i + 1, 2).Select
    .Rows(i + 1).RowHeight = 42
    .Pictures.Insert(ipath & "\" & .Cells(i, 1) & ".jpg").Select
    Selection.ShapeRange.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft
    i = i + 1
    GoTo 10  
    End With

这个是我将jpg文件下图片插入excel单元格下一格位置的VBA,供你参考吧.

不知道你的图片是怎么来的.

追问

我是复制粘贴来的，关键是粘贴的位置有偏差，指定B80插入，结果实际插入式B78
如果缩小行距，又查到B82，感觉他插入的位置不跟实际单元格走

Answer 4

全程序发来看看

追问

aShape.Copy

y = 80
x =2
stMap.Activate
ActiveSheet.Paste
With Selection
.ShapeRange.LockAspectRatio = msoTrue
.Top = Cells(y, x).Top + iMargin
.Left = Cells(y, x).Left + iMargin
End With

追答

aShape.Copy
y = 80
x =2
stMap.Activate
 ActiveSheet.Paste
With Selection
.ShapeRange.LockAspectRatio = msoTrue
 .Top = ActiveSheet.Cells(y, x).Top + iMargin
.Left = ActiveSheet.Cells(y, x).Left + iMargin
End With

追问

试过了，没用，包括
.Top = stMap.Cells(y, x).Top + iMargin
.Left =stMap. Cells(y, x).Left + iMargin
也没用

追答

aShape.Copy
y = 80
x =2
ActiveSheet.Paste
With Selection
.ShapeRange.LockAspectRatio = msoTrue
 .Top = ActiveSheet.Cells(y, x).Top 
.Left = ActiveSheet.Cells(y, x).Left 
End With