Question

我发现大量的vba用于将图像插入评论

Selection.ShapeRange.Fill.UserPicture "C:\Temp\Pictures\ewe.jpg"

如何确定已用于评论的图像？

如果可能，我想提取嵌入的图像名称。

是否没有可以访问的属性会给我这个？在注释“填充效果”对话框中，图像名称似乎无法访问。

enter image description here

Answer 1

很抱歉，我没有声明只是评论您的问题以澄清。

我制作了一个测试文件，在该注释中插入了注释和图像，然后提取了基本文件。然后我检查了所有原始文件名。我还找到了嵌入式JPEG并对其进行解码以获取元数据。如您所知，原始文件名存储在xl \ drawings \ vmlDrawing1.vml中（一旦从excel文件中提取xml文件，方法是将.zip附加到文件名，然后在其上运行解压缩实用程序）。我确实找到了文件名，但没有找到路径或文件类型，所以我很确定路径和文件类型不会被保留。

如果只有文件名就足够了，那么该文件包含您拥有的每个图纸的信息，并且这些信息将包括单元格位置，尽管它们基于0，因此您必须添加一个才能获得实际的行和列。我的问题是两部分：

1）文件名是否足够，或者您是否需要整个路径？如果您需要整个路径，我认为您运气不好，因为路径位于不同的计算机上，如果您提取文件名，甚至无法搜索它们。

2）如果这就是您所需要的，那么解决方案必须是VBA吗？在过去，我已经以编程方式解压缩并操作了xml基本文件，但这有点棘手。只需要读出数据就可以简化它，这是一个优点。我之前在.net中做过，但我确信如果它必须是VBA就可以完成，但是如果你对这种解决方案持开放态会更简单。

让我知道，我很乐意帮助你。

=============================================== =====================================

试试这个：制作电子表格的副本，附加.zip（test.xlsm.zip），然后手动提取文件。将vmlPath更改为xl \ drawings \ vmlDrawing1.vml文件的位置。然后运行它。我做了一些假设，例如，我假设节点和属性的顺序总是相同，所以我使用硬编码索引（shp.attributes（0）等）而不是使用逻辑来确保我有正确的节点或属性，但你似乎知道你的方式围绕VBA，所以我只是编码准系统。这需要引用Microsoft XML 6.0。

Sub vmlParse()

    Dim vmlPath As String: vmlPath = "C:\Users\Lenovo\Desktop\test - Copy.xlsm\xl\drawings\vmlDrawing1.vml"
    Dim this As Worksheet: Set this = ActiveSheet
    Dim doc As New DOMDocument, shps As IXMLDOMNodeList
    Dim shp As IXMLDOMNode, n As IXMLDOMNode, a As IXMLDOMAttribute
    Dim fileName As String, productID As String
    Dim rng As Range, r As Long, c As Long

    doc.Load vmlPath

    Set shps = doc.getElementsByTagName("x:ClientData")
    For Each shp In shps

        If shp.Attributes(0).nodeValue = "Note" Then

            r = 0: c = 0

            For Each a In shp.ParentNode.FirstChild.Attributes
                If a.nodeName = "o:title" Then
                    fileName = a.nodeValue
                    Exit For
                    End If
                Next

            For Each n In shp.childNodes

                If n.nodeName = "x:Row" Then r = n.text
                If n.nodeName = "x:Column" Then c = n.text

                Next

            Set rng = this.Cells(r + 1, c + 1)
            productID = rng.Value

            'now you have the productID, the fileName, and the cell location

            End If
        Next

End Sub

让我知道这对您有何影响。

Answer 2

如果 c4 包含您的评论：

Set shp = Range("C4").Comment.Shape
     if shp.Fill.TextureType = msoTextureUserDefined then

end if

在Excel注释中确定图像

2 个答案: