一直在網路上尋找，變更EXCEL圖表標籤的工具。
其巨集內容如下。存放於部落格備用，該工具可以省去不少人工修改操作。
簡體內容變亂碼，重新修改成看的懂內容。
Option Explicit
Sub DataLableChange()
Dim I%, LblCnt%, iRows%, iCols%
Dim shnm$, sn$, Msg$
Dim rngLbl As Range
Select Case TypeName(Selection)
Case "DataLabel"
sn = Selection.Parent.Parent.Name
Case "DataLabels"
sn = Selection.Parent.Name
Case "Series"
sn = Selection.Name
Case Else
MsgBox "請先選擇要變更的標籤,再執行此巨集", vbOKOnly, "尚未選擇要變更的資料標籤"
Exit Sub
End Select
Err.Clear: On Error Resume Next
Set rngLbl = Application.InputBox("請輸入標籤所引用的區域,可以用滑鼠選擇區域", "標籤的引用區域", , , , , , 8)
Err.Clear: On Error GoTo 0
If rngLbl Is Nothing Then Exit Sub
iRows = rngLbl.Rows.Count
iCols = rngLbl.Columns.Count
LblCnt = ActiveChart.SeriesCollection(sn).Points.Count
shnm = rngLbl.Parent.Name
If Application.Max(iRows, iCols) < ActiveChart.SeriesCollection(sn).Points.Count Then
Msg = MsgBox("所引用的區域與標籤區域數量不符" & Chr(10) & "選""Yes""依選擇區域更改" & Chr(10) & "選""No""重新選擇區域", vbYesNo, "警告")
Select Case Msg
Case vbYes
LblCnt = Application.Max(iRows, iCols)
Case vbNo
Exit Sub
End Select
End If
Application.ScreenUpdating = False
On Error Resume Next
With ActiveChart.SeriesCollection(sn)
For I = 1 To LblCnt
Err.Clear
.Points(I).ApplyDataLabels
If Err.Number = 0 Then
If iRows > iCols Then
.Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(I, 1).Resize(1, iCols).Address(ReferenceStyle:=xlR1C1)
Else
.Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(1, I).Resize(iRows, 1).Address(ReferenceStyle:=xlR1C1)
End If
End If
Next
End With
Err.Clear: On Error GoTo 0
Application.ScreenUpdating = True
End Sub
