在图表中定位标签

eir*_*ude 5 excel vba excel-vba excel-2016

我有一个包含两个图表的电子表格,我想根据表格中的值在其中一个系列的点旁边添加一些文本框.

我为此创建了两个程序,每个程序都有自己的优点和缺点:

Sub add_comments(apply_to As Series, source_range As Range) 
  Dim i As Long 
  Dim c As Range 

  If source_range.Count > apply_to.Points.Count Then 
    Set source_range = source_range.Resize(apply_to.Points.Count, 1) 
  End If 

  i = 1 
  For Each c In source_range 
    If Not IsError(c) And i <= apply_to.Points.Count Then 
      If Len(c.Text) <> 0 Then 
        apply_to.Points(i).HasDataLabel = True 
        apply_to.Points(i).DataLabel.Text = c.Value2 
        apply_to.Points(i).DataLabel.Format.AutoShapeType = msoShapeRectangularCallout 
        With apply_to.Points(i).DataLabel.Format.Line 
          .Visible = msoTrue 
          .ForeColor.RGB = RGB(0, 0, 0) 
        End With 
        apply_to.Points(i).DataLabel.Position = xlLabelPositionAbove 
      Else 
        If apply_to.Points(i).HasDataLabel Then 
          apply_to.Points(i).DataLabel.Delete 
        End If 
      End If 
    End If 
    i = i + 1 
  Next c 
End Sub 
Run Code Online (Sandbox Code Playgroud)

上面的代码使用标签,这是非常理想的,除了我不能重新定位标签,它们重叠时会有点难看.

Sub alternative_comments(apply_to As Series, source_range As Range) 
  Dim c As Range 
  Dim i As Long 

  If source_range.Count > apply_to.Points.Count Then 
    Set source_range = source_range.Resize(apply_to.Points.Count, 1) 
  End If 

  i = 1 
  For Each c In source_range 
    If Not IsError(c) And i <= apply_to.Points.Count Then 
      If Len(c.Text) <> 0 Then 
        With SPC_01.Shapes.AddLabel(msoTextOrientationHorizontal, 100, 100, 10, 10) 
          .TextFrame2.TextRange.Characters.Text = c.Text 
          With .Line 
            .Visible = msoTrue 
            .ForeColor.RGB = RGB(0, 0, 0) 
          End With 
          .Top = apply_to.Points(i).Top - .Height 
          .Left = apply_to.Points(i).Left - .Width 

          Debug.Print apply_to.Points(i).Top & " - " & .Top 
          Debug.Print apply_to.Points(i).Left & " - " & .Left 
        End With 
      End If 
    End If 
    i = i + 1 
  Next c 
End Sub 
Run Code Online (Sandbox Code Playgroud)

另一个解决方案使用文本框,这非常适合移动和调整大小,但不会自动缩放以适应文本,我也找不到任何明智的方法来做到这一点.

在此输入图像描述

正如你所看到的那样,我坚持使用这两种方法,尽管我觉得使用标签的缺点不如使用文本框那么严重.但是,我想知道你们中是否有人能告诉我自动为系列中的数据点添加注释的最佳方法是什么?我是在正确的轨道上吗?

我还将这个问题发布到VBAExpress论坛,如果你们中的任何一个想要查看整个工作簿.

Ste*_*eES 0

对于文本框方法,您可以使用以下方法将其设置为自动调整大小:

.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
Run Code Online (Sandbox Code Playgroud)

然后有两个文本换行选项可以改变外观。您可以将文本设置为换行:

.TextFrame2.WordWrap = True
Run Code Online (Sandbox Code Playgroud)

这不会改变文本框的宽度,它会像上面一样垂直地串出文本框。

或者您可以将其设置为不换行:

.TextFrame2.WordWrap = False
Run Code Online (Sandbox Code Playgroud)

这会将其水平串起来,直到遇到换行符。

因此,您可以根据需要设置文本框宽度并打开换行,或者在源文本中添加显式换行符 (Alt + Enter) 并关闭换行。