怎样用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、输入完成之后我们点击保存就可以看到，我们直接插入了图片到文档当中，而不仅仅是一个链接了，即便我们移动文档或者移动图片，都不影响我们文档当中所插入的照片，