VB創建excel2010圖片由連結修改為插入儲存

[fai000]

我的VB代碼插入圖片在office2010變成連結圖片,誰能幫小弟修改以下代碼，謝謝。

Public Sub addPicture(ByVal strFileName As String, _
ByVal lngLeft As Long, ByVal lnTop As Long, _
ByVal lngWidth As Long, ByVal lngHeight As Long)

'Call XLsheet.Shapes.AddPicture(strFileName, False, True, lngLeft, lnTop, lngWidth, lngHeight)

End Sub

Public Sub InsertPicture(ByVal strFilePathName As String, _
ByVal strPosition As String, _
ByVal dblImageWidth As Decimal)
XLsheet.Range(strPosition).Select()


XLsheet.Pictures.Insert(strFilePathName).Select()
'Selection.ShapeRange.LockAspectRatio = True
'Selection.ShapeRange.Width = dblImageWidth
End Sub

Public Sub InsertCellPicture(ByVal row As Integer, ByVal col As Integer, ByVal strFilePathName As String )
XLsheet.Cells(row, col).Select()
XLsheet.Pictures.Insert(strFilePathName).Select()
'Selection.ShapeRange.LockAspectRatio = True
'Selection.ShapeRange.Width = dblImageWidth
End Sub

[脆皮大雪糕]

Sub 宏1()
'

    '向当前sheet插入图片
    addPicture ActiveSheet, "B:\ab.jpg", 100, 100, 250, 125
    '向指定sheet插入图片
    addPicture Sheets("Sheet1"), "B:\ab.jpg", 100, 100, 250, 125
    
End Sub
Public Sub addPicture(XLSheet As Object, ByVal strFileName As String, _
        ByVal lngLeft As Long, ByVal lnTop As Long, _
        ByVal lngWidth As Long, ByVal lngHeight As Long)
        
    Dim objRange
    Set objRange = XLSheet.Pictures.Insert(strFileName)
    objRange.ShapeRange.Left = lngLeft
    objRange.ShapeRange.Top = lnTop
    objRange.ShapeRange.Width = lngWidth
    objRange.ShapeRange.Height = lngHeight
End Sub

[脆皮大雪糕]

Sub 宏1()
'
    
    '向指定sheet 的指定 range位置插入图片，并且拉伸图片适应range
    Dim objDesRange As Range
    
    Set objDesRange = Sheets("Sheet1").Range("B2:C4")
    addPicture Sheets("Sheet1"), "B:\ab.jpg", objDesRange.Left, objDesRange.Top, objDesRange.Width, objDesRange.Height, True
    
End Sub
Public Sub addPicture(XLSheet As Object, ByVal strFileName As String, _
        ByVal lngLeft As Long, ByVal lnTop As Long, _
        ByVal lngWidth As Long, ByVal lngHeight As Long, _
        ByVal blnIsScale As Boolean)
        
    Dim objRange
    Set objRange = XLSheet.Pictures.Insert(strFileName)
    If blnIsScale Then '拉伸
        objRange.ShapeRange.LockAspectRatio = msoFalse
    Else '保持原图比例
        objRange.ShapeRange.LockAspectRatio = msoTrue
    End If
    objRange.ShapeRange.Left = lngLeft
    objRange.ShapeRange.Top = lnTop
    objRange.ShapeRange.Width = lngWidth
    objRange.ShapeRange.Height = lngHeight
End Sub

改进一下，增加参数确定是否不锁定长宽比例拉伸。 并且在调用样例中以range来确定图片的位置和大小。

[huangyz975136]

还是不行啊，改变图片路径以后依然无法显示！求解啊