怎样解决使用VBA插入图片出现整体向上偏移情况

1、首先在开发工具中打开VBA编辑器

2、在单元格区域当中输入一些内容作为例子

3、在VBA编辑器中插入模块

4、在模块当中输入如下代码，然后运行

Sub ShapePic()

 

    Dim shpPic As Shape

 

    Dim i, j, k As Long

 

    Dim filpath As String

 

    Dim rng As Range

 

'    Dim picW As Single, picH As Single      '图片的宽和高

 

    Dim cellW As Single, cellH As Single    '单元格的宽和高

 

    Dim cellL As Single, cellT As Single    '单元格的左边和上边位置（左上角）

 

'    Dim rtoW As Single, rtoH As Single      '单元格和图片的宽和高的比例

    For Each im In ActiveSheet.Shapes

 

        im.Delete

 

    Next

    For i = 0 To 5

 

    For j = 2 To 7 Step 5

 

    For k = 0 To 1

 

    'For Each rng In Range("B" & (6 + i * 8) & ":G" & (7 + i * 8))

 

    'For Each rng In Range(B6)

 

    For Each rng In Cells(6 + i * 8 + k, j)

 

   

 

    If rng.MergeCells Then           '判断所选单元格是否是合并单元格

 

        cellW = rng.MergeArea.Width  '是的话，cellW和cellH分别等于合并单元格的宽和高

 

        cellH = rng.MergeArea.Height

 

    Else

 

        cellW = rng.Width            '不是的话，cellW和cellH分别等于单元格的宽和高

 

        cellH = rng.Height

 

    End If

 

    cellL = rng.Left

 

    cellT = rng.Top

 

   

 

    filpath = "E:\02" & "\" & ActiveSheet.Cells(6 + i * 8 + k, j).Text & ".jpg"

 

    If Not IsEmpty(rng) Then

 

    If Dir(filpath) <> "" Then

 

    'Set shpPic = ActiveSheet.Shapes.AddPicture(filpath, msoFalse, msoTrue, cellL + 10, cellT + 10, cellW - 20, cellH - 20)

 

    Set shpPic = ActiveSheet.Shapes.AddPicture(filpath, msoFalse, msoTrue, cellL + 10, cellT + 10, cellW - 20, cellH - 20)

 

'    picW = shpPic.Width

 

'    picH = shpPic.Height

 

'    rtoW = cellW / picW * 0.9              '设置单元格和图片的比例。并设置最终比例为原始比例的98%；

 

'    rtoH = cellH / picH * 0.9              '这样的目的在于不要让图片充满整个单元格，以便可以让人看到单元格的边线。

 

    shpPic.LockAspectRatio = msoFalse

 

'    If rtoW < rtoH Then

 

'        shpPic.ScaleHeight rtoW, msoTrue, msoScaleFromTopLeft

 

'        'shpPic.ScaleWidth rtoW, msoTrue, msoScaleFromTopLeft

 

'    Else

 

'        shpPic.ScaleHeight rtoH, msoTrue, msoScaleFromTopLeft

 

'        'shpPic.ScaleWidth rtoH, msoTrue, msoScaleFromTopLeft

 

'    End If

 

    End If

 

    End If

 

    Next

 

    Next

 

    Next

 

    Next

 

    ActiveSheet.Cells(1, 2).Select

 

'    picW = shpPic.Width       '根据上面确认的比例，为图片的宽和高重新赋值

 

'    picH = shpPic.Height

 

'    shpPic

5、最后我们就可以看到成功的在表格当中插入了图片，

6、通过这样的方式插入的图片会出现两种情况，第1种情况就是如果在WPS office当中插入图片的话，前面的图片的格式问题不大，

7、但是越往后面就可以看到插入的图片，整体会往上面偏移，甚至都超出了我们所设置的单元格的范围，

8、要解决这一个问题，我们最好是用Microsoft office当中的表格，而且它的VBa编辑器都是免费的，

9、使用同样的代码插入了图片之后，我们可以看到，无论是第1行或者是最后一行图片的格式，都是我们所设置的格式，而没有出现偏移的状况，