如何阻止下载的图像掉到桌子上?

时间:2019-07-08 08:38:32

标签: excel vba

我使用VBA创建了一个工具,该工具可以接收电子表格输入并生成PDF报告输出。该报告的一部分包含在线托管的图片,以及指向存储在单元格中的这些图片的链接。

此工具的部分代码下载这些图像并将其放置在保存链接的单元格上方,将其格式化为单元格的预设尺寸(100 x 100px)

当image列中的每个单元格都有一个图片链接时,该代码可以正常工作。但是,并非报表中的所有订单项都附有图片。

发生这种情况时,空白单元格之前的最后一个图像将被放置在下一个图像链接之前的最后一个空白单元格,本质上是“下拉”到报告中的错误位置。

我尝试修改代码,但无济于事。我想出了一个临时修复方法,可以使用IFBLANK格式化单元格(链接到白色正方形的图像),以便插入该白色正方形以显示空白单元格的外观,但是这要求用户保留白色的图像正方形,并直接在代码中引用它,或者将白色正方形托管在一个我不满意的永久活动站点上。我希望该工具尽可能地适用于未来,以便其他人可以继续使用它。

    'Download Images
    Dim Pshp As Shape
    Dim xRg As Range
    Dim xCol As Long

    On Error Resume Next

    Set Rng = Sheets("POMEC Report").Range(Sheets("POMEC DATA").Range("R6"))

    For Each Cell In Rng
        filenam = Cell
        ActiveSheet.Pictures.Insert(filenam).Select
        Set Pshp = Selection.ShapeRange.Item(1)

        If Pshp Is Nothing Then GoTo lab

        xCol = Cell.Column
        Set xRg = Cells(Cell.Row, xCol)

        With Pshp
            .LockAspectRatio = msoFalse
            .Width = 100
           .Height = 100
            .Top = xRg.Top + (xRg.Height - .Height) / 2
            .Left = xRg.Left + (xRg.Width - .Width) / 2
        End With
lab:
        Set Pshp = Nothing

    Next

我在另一个选项卡中有一个辅助单元格,该单元格可以计算报告中的最后一行数据,因此我可以使范围动态化(POMEC Report R6),但是即使对该范围进行了硬编码,也会出现此错误。

我做错了什么导致这个?任何帮助将不胜感激!

0 个答案:

没有答案