我正在搜索/尝试制作一个宏来固定具有一个或多个系列集合的折线图中数据标签的位置，以便它们不会相互重叠。
我正在为我的宏考虑一些方法，但是当我尝试实现它时，我明白这对我来说太难了，我很头疼。
有什么我错过的吗？你知道这样的宏吗？
这是一个带有重叠数据标签的示例图表：
这是我手动修复数据标签的示例图表：
【问题讨论】：
标签： excel charts excel-2007 vba
此任务基本上分为两个步骤：访问Chart对象以获取Labels，以及操作标签位置以避免重叠。 p>
对于给定的样本，所有系列都绘制在一个共同的 X 轴上，并且 X 值足够分散，标签不会在该维度上重叠。因此，提供的解决方案只处理每个 X 点的标签组。
这个Sub解析图表并为每个X点依次创建一个Labels数组
Sub MoveLabels()
Dim sh As Worksheet
Dim ch As Chart
Dim sers As SeriesCollection
Dim ser As Series
Dim i As Long, pt As Long
Dim dLabels() As DataLabel
Set sh = ActiveSheet
Set ch = sh.ChartObjects("Chart 1").Chart
Set sers = ch.SeriesCollection
ReDim dLabels(1 To sers.Count)
For pt = 1 To sers(1).Points.Count
For i = 1 To sers.Count
Set dLabels(i) = sers(i).Points(pt).DataLabel
Next
AdjustLabels dLabels ' This Sub is to deal with the overlaps
Next
End Sub
这会调用AdjustLables 并带有Labels 的数组。需要检查这些标签是否重叠
Sub AdjustLabels(ByRef v() As DataLabel)
Dim i As Long, j As Long
For i = LBound(v) To UBound(v) - 1
For j = LBound(v) + 1 To UBound(v)
If v(i).Left <= v(j).Left Then
If v(i).Top <= v(j).Top Then
If (v(j).Top - v(i).Top) < v(i).Height _
And (v(j).Left - v(i).Left) < v(i).Width Then
' Overlap!
End If
Else
If (v(i).Top - v(j).Top) < v(j).Height _
And (v(j).Left - v(i).Left) < v(i).Width Then
' Overlap!
End If
End If
Else
If v(i).Top <= v(j).Top Then
If (v(j).Top - v(i).Top) < v(i).Height _
And (v(i).Left - v(j).Left) < v(j).Width Then
' Overlap!
End If
Else
If (v(i).Top - v(j).Top) < v(j).Height _
And (v(i).Left - v(j).Left) < v(j).Width Then
' Overlap!
End If
End If
End If
Next j, i
End Sub
当检测到重叠时，您需要一种策略来移动一个或两个标签而不造成另一个重叠。
这里有很多可能性，你没有给出足够的细节来判断你的要求。
要使这种方法起作用，您需要具有 DataLabel.Width 和 DataLabel.Height 属性的 Excel 版本。 2003 SP2 版（可能更早）没有。
【讨论】：
Abs(v(j).Top - v(i).Top) < v(i).Height 以避免同时检查 (v(j).Top - v(i).Top) < v(i).Height 和 (v(i).Top - v(j).Top) < v(i).Height。事实上，您的整个 If 构造树都可以替换为 If Abs(v(j).Top - v(i).Top) < v(i).Height And Abs(v(j).Left - v(i).Left) < v(i).Width。
v(i)高于v(j)，那么重要的是v(i)的高度，否则是@987654337 @。同样的论点适用宽度。 2) 相对位置可能对移动标签的策略感兴趣，这种结构可以被识别。
当数据源列在相邻的两个列中时，此宏将防止两个折线图上的标签重叠。
Attribute VB_Name = "DataLabel_Location"
Option Explicit
Sub DataLabel_Location()
'
'
' *******move data label above or below line graph depending or other line graphs in same chart***********
Dim Start As Integer, ColStart As String, ColStart1 As String
Dim RowStart As Integer, Num As Integer, x As Integer, Cell As Integer, RowEnd As Integer
Dim Chart As String, Value1 As Single, String1 As String
Dim Mycolumn As Integer
Dim Ans As String
Dim ChartNum As Integer
Ans = MsgBox("Was first data point selected?", vbYesNo)
Select Case Ans
Case vbNo
MsgBox "Select first data pt then restart macro."
Exit Sub
End Select
On Error Resume Next
ChartNum = InputBox("Please enter Chart #")
Chart = "Chart " & ChartNum
ActiveSheet.Select
ActiveCell.Select
RowStart = Selection.row
ColStart = Selection.Column
ColStart1 = ColStart + 1
ColStart = ColNumToLet(Selection.Column)
RowEnd = ActiveCell.End(xlDown).row
ColStart1 = ColNumToLet(ActiveCell.Offset(0, 1).Column)
Num = RowEnd - RowStart + 1
With ThisWorkbook.ActiveSheet.Select
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(2).ApplyDataLabels
End With
For x = 1 To Num
Value1 = Range(ColStart & RowStart).Value
String1 = Range(ColStart1 & RowStart).Value
If Value1 = 0 Then
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Delete
End If
If String1 = 0 Then
ActiveSheet.ChartObjects(Chart).Activate
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Delete
End If
If Value1 <= String1 Then
ActiveSheet.ChartObjects("Chart").Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Position = xlLabelPositionBelow
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Position = xlLabelPositionAbove
Else
ActiveSheet.ChartObjects("Chart").Activate
ActiveChart.SeriesCollection(1).DataLabels(x).Select
Selection.Position = xlLabelPositionAbove
ActiveChart.SeriesCollection(2).DataLabels(x).Select
Selection.Position = xlLabelPositionBelow
End If
RowStart = RowStart + 1
Next x
End Sub
'
' convert column # to column letters
'
Function ColNumToLet(Mycolumn As Integer) As String
If Mycolumn > 26 Then
ColNumToLet = Chr(Int((Mycolumn - 1) / 26) + 64) & Chr(((Mycolumn - 1) Mod 26) + 65)
Else
ColNumToLet = Chr(Mycolumn + 64)
End If
End Function
【讨论】：
虽然我同意常规 Excel 公式不能解决所有问题，但我不喜欢 VBA。造成这种情况的原因有很多，但最重要的一个是它很可能会在下一次升级时停止工作。我并不是说你根本不应该使用 VBA，而是只在必要时使用它。
您的问题是不需要 VBA 的一个很好的例子。“好的”你说，“但是我该如何解决这个问题？”感觉很幸运，点击这个链接来回答我的相关问题here。
您将在链接中找到如何测量图表的精确网格。当您的 x 轴与 0 交叉时，您只需要最大的 Y 轴标签即可。你现在只有一半，因为你的具体问题还没有解决。以下是我将如何进行：
首先衡量您的标签与图表高度相比的高度。这将需要一些试验和错误，但应该不是很困难。如果您的图表可以堆叠 20 个标签而不会重叠，那么这个数字就是 0.05。
接下来确定任何标签是否重叠以及重叠的位置。这很容易，因为您需要做的就是找出数字彼此太接近的位置（在我的示例中，在 0.05 范围内）。
使用一些布尔测试或所有我关心的 IF 公式来找出答案。您所追求的结果是一个表格，其中包含每个系列的答案（第一个除外）。不要害怕再次复制该表以进行下一步：创建新的图表输入。
有几种方法可以创建新图表，但这是我要选择的一种。为每个系列创建三行。一条是实际线，另外两条是仅带有数据标签的不可见线。对于每一行，都有一条不可见的线，只有常规标签。这些都使用相同的对齐方式。每条额外的不可见线都有不同的标签对齐方式。您的第一个系列不需要一个，但对于第二个系列，标签将位于右侧，第三个位于下方，第四个位于左侧（例如）。
当没有数据标签重叠时，只有第一条不可见的线（常规对齐）需要显示值。当标签确实重叠时，相应的额外不可见线应接管该点并显示其标签。当然第一条不可见的线不应该在那里显示。
当所有四个标签在同一 x 轴值处重叠时，您应该会看到第一条基本不可见线的标签和三个额外不可见线的标签。这应该适用于您的示例图表，因为有足够的空间移动到左右标签。就个人而言，我会在重叠点只使用最小值和最大值标签，因为它重叠的事实首先表明这些值非常接近。..
希望对你有帮助，
您好，
帕特里克
【讨论】：
@克里斯·尼尔森 您能否在 Excel 2007 上测试您的解决方案？ 当我将对象转换为 DataLabel 类时，看起来 .Width 属性已从类中删除。 （对不起，我不被允许评论你的回复）
也许从下面的论坛添加的一件事是临时调整标签的位置： http://www.ozgrid.com/forum/showthread.php?t=90439 “您可以通过强制标签离开图表并将报告的左侧/顶部值与宽度/高度内的图表区域的值进行比较来获得数据标签的接近宽度或高度值。”
基于此，请将 v(i).Width & v(j).Width 移至变量 sng_vi_Width & sng_vj_Width 并添加这些行
With v(i)
sngOriginalLeft = .Left
.Left = .Parent.Parent.Parent.Parent.ChartArea.Width
sng_vi_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left
.Left = sngOriginalLeft
End With
With v(j)
sngOriginalLeft = .Left
.Left = .Parent.Parent.Parent.Parent.ChartArea.Width
sng_vj_Width = .Parent.Parent.Parent.Parent.ChartArea.Width - .Left
.Left = sngOriginalLeft
End With
【讨论】：
.Height 和 .Width 属性包含在 VBA 对象模型中。