☰

有条件地将图像添加到气泡图吗？

tag-icon • tag-icon microsoft-excel charts conditional-statements
有条件地将图像添加到气泡图吗？

我需要为大量同侪群体批量制作气泡图，每个图表显示匿名同侪群体数据，但用团队徽标突出显示感兴趣的群体。我想使用 VBA 自动执行此操作，但想知道是否有可能有条件地在每个图表中向感兴趣的气泡添加图片？目前这是一个手动过程，需要相当多的时间。

例如，在图表 1 中，A 队是值得关注的球队，其气泡上有其徽标，而其余气泡则为相同的纯色。在图表 2 中，B 队是值得关注的球队，等等。

答案1

我无法发表评论。但问题的一部分在于你每次都要重新生成数据和图表。因此，通常使用的解决方案是“间接”。解决一个更简单的问题。

您是否可以制作一个包含所有徽标的隐藏表格。徽标旁边是与该徽标（徽标或徽标的文件名）相对应的编号。

接下来，编写一个宏，如果这些数字正确，则正确分配您想要的徽标（即，您只需更新该表，并将该表用作 VBA 中的数组）。

最后，如果您在发送表格时只更新一个徽标，那么我会将其作为文件名的一部分（并在公式中使用它）或将其放在更显眼的单元格中。然后您的链接就完成了。对该单元格进行一次更改，点击宏，您就可以开始了。

如果没有看到你正在使用的代码，我无法提供更多帮助。

答案2

我已经搞清楚了。首先需要用两个定义的系列设置我的数据，其中一个系列是感兴趣的组，第二个系列是同类组，然后根据组有条件地填充数据表中的单元格。设置过程花了很多时间才搞清楚，下面的说明看起来很详尽，但实际上并没有那么糟糕。

餐桌布置快照

以蓝色突出显示的所有内容都是公式，因此我是这样操作的：

  1. 在 B 列中，我使用公式来识别哪个系列是哪个：=IF(A5<>A$1,"Peers","Group")
  2. 输入我的 X 和 Y 值（C 和 D 列）。
  3. 将气泡大小（E 列）设置为根据系列自动调整：=IF(A5=A$1,1000,250)
  4. 使用 F 列和 G 列来修剪小数位。
  5. H 到 L 列反映根据该组是同行还是感兴趣的组而设置的实际数据系列。
  6. X 始终保持不变，因此我将 H 列链接到原始 X 轴值：=C5
  7. 如果它是一个同级组，则 I 列提取适当的 Y 值：=IF($B5=$I3,$D5,NA())
  8. J 列设置同行组气泡大小：=IF(ISNA($I5),NA(),$E5)
  9. 如果是感兴趣的组，则 K 列会提取适当的 Y 值：=IF($B5=$K$3,$D5,NA())
  10. L 列设置感兴趣的气泡大小：=IF(ISNA($K5),NA(),$E5)
  11. M 列将所有气泡大小设置为相等，并用于最终创建的图表，其中所有组及其徽标一起显示。
  12. 当选择感兴趣的组时，单元格 O4 (=VLOOKUP(A1,Logos!A:B,2,FALSE)) 和 P4 (=IF(O4=1,"group1",IF(O4=2,"group2",IF(O4=3,"group3",IF(O4=4,"group4"))))) 识别并提取正确的徽标。

然后，我必须在单独的选项卡（“徽标”）中设置并链接我的所有徽标/图像。Oz du Soleil 的 YouTube 视频“根据单元格值选择图像”对完成此操作非常有帮助。我的声誉不够，无法发布直接链接。

我创建并格式化了气泡图，然后使用 H 列（X 轴）、I/K（Y 轴）和 J/L（气泡大小的 Z 轴）为每个系列选择所需的数据。

对于我的完整集团徽标图表，我只需要一系列，因为所有气泡的大小都相同。我分别使用 C、D 和 M 列作为 X、Y 和 Z 轴。然后我将每个集团徽标应用到各自的气泡上。

设置完成后，代码本身就非常简单了：

Dim i As Long
Dim iLastRow As Long
Dim Cells As Range

'This section looks up each group name on the tab and cycles through the loop
Application.ScreenUpdating = False

With ActiveSheet
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 4 To iLastRow - 1 'Group names start in A5

        'Selects, copies, and pastes the next group name in the list
        Sheets("Groups").Select
        ActiveSheet.Cells(i + 1, 1).Copy
        Range("A1").Select
            Selection.PasteSpecial paste:=xlPasteValues

        'Selects, copies, and pastes the group logo onto the bubble
        ActiveSheet.Shapes.Range(Array("Picture 7")).Select
            Selection.CopyPicture xlScreen, xlPicture
        ActiveSheet.ChartObjects("Chart 6").Activate
        ActiveChart.FullSeriesCollection(2).Select
            Selection.paste

        'Variables needed for directory and file names
        GroupName = Sheets("Groups").Range("A1")
        yearmo = Sheets("Groups").Range("A2")

        'Will create a new folder for the final images if it doesn't already exist
        If Len(Dir("DirPath\" & yearmo, vbDirectory)) = 0 Then
        MkDir "DirPath\" & yearmo
        End If

        'Set up image file names
        Dim NewFileName As String
        NewFileName = "\" & yearmo & " - " & GroupName & " - X_Y.jpg"

        'Selects and saves the bubble chart as a JPG
        ActiveChart.ChartArea.Select
        ActiveChart.Export "DirPath\" & yearmo & NewFileName

    Next i
End With

    'After all individual bubble have been created, need to
    'set up state file name to generate image with all logos for the state
    Dim StateFileName As String
    StateFileName = "\" & yearmo & " - STATE - X_Y.jpg"

    'Selects and saves the state bubble chart as a JPG
    ActiveSheet.ChartObjects("Chart 4").Activate
    ActiveChart.Export "DirPath\" & yearmo & StateFileName

填充气泡图

我选择不使用图表中的标签，因为尝试让它们动态定位似乎不值得付出努力。相反，我选择在图表下方创建链接文本框。

希望这对其他人有所帮助；这无疑可以节省大量手动更新的时间。

相关内容