【VBA】ボタン一つで散布図の系列色を変更する

2025年10月18日

概要

本記事では、ワークシート上のボタンを一つクリックするだけで、散布図の特定系列の線色を変更する方法をご説明いたします。系列の種類やマーカー設定には一切触れず、凡例の並びを変えないことを重視した構成です。

前提条件

Microsoft 365 版 Excel を使用していること。
対象のグラフは散布図であること。
変更対象の系列名をセル AB17 に記入しておくこと。
ボタンは一つのみ配置し、後述のマクロを割り当てること。

手順

開発タブから「挿入」より図形を一つ配置し、右クリックの「マクロの登録」で後述の Change_the_ColorLine_AB17 を割り当てます。
セル AB17 に、色を変更したい系列名を正確に入力します。
ボタンをクリックし、表示される色選択ダイアログから任意の色を選択します。
アクティブシート上の全ての埋め込み散布図に対し、AB17 と完全一致する系列名を持つ系列の線色のみが変更されます。

コード全文

以下のコードを標準モジュールに貼り付けてご利用ください。

Option Explicit

'==============================
' 色選択ダイアログ（32/64bit 対応）
'==============================
#If VBA7 Then
    Private Type CHOOSECOLOR
        lStructSize     As Long
        hwndOwner       As LongPtr
        hInstance       As LongPtr
        rgbResult       As Long
        lpCustColors    As LongPtr
        Flags           As Long
        lCustData       As LongPtr
        lpfnHook        As LongPtr
        lpTemplateName  As LongPtr
    End Type

    Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" ( _
        ByRef pChoosecolor As CHOOSECOLOR) As Long
#Else
    Private Type CHOOSECOLOR
        lStructSize     As Long
        hwndOwner       As Long
        hInstance       As Long
        rgbResult       As Long
        lpCustColors    As Long
        Flags           As Long
        lCustData       As Long
        lpfnHook        As Long
        lpTemplateName  As String
    End Type

    Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" ( _
        ByRef pChoosecolor As CHOOSECOLOR) As Long
#End If

Private Const CC_RGBINIT  As Long = &H1&
Private Const CC_FULLOPEN As Long = &H2&

Private Function ShowColorDialog(Optional ByVal DefaultColor As Long = 0) As Long
    Dim cc As CHOOSECOLOR
#If VBA7 Then
    Dim aCust(0 To 15) As Long
#Else
    Dim CustColors As String
#End If

    With cc
        .lStructSize = Len(cc)
        .hwndOwner = Application.Hwnd
        .Flags = CC_RGBINIT Or CC_FULLOPEN
        .rgbResult = DefaultColor
#If VBA7 Then
        .lpCustColors = VarPtr(aCust(0))
#Else
        CustColors = String$(16 * 4, vbNullChar)
        .lpCustColors = CustColors
#End If
    End With

    If ChooseColor(cc) <> 0 Then
        ShowColorDialog = cc.rgbResult
    Else
        ShowColorDialog = -1
    End If
End Function

'==============================
' 中核：色だけを変更（凡例順は不変）
' 触るのは Line.ForeColor.RGB のみ
'==============================
Private Sub ChangeColor_ScatterOnly_ColorOnly(ByVal cellAddress As String)
    Dim ws As Worksheet
    Dim targetName As String
    Dim chosen As Long
    Dim co As ChartObject
    Dim sc As SeriesCollection
    Dim s As Series
    Dim i As Long
    Dim ct As XlChartType

    Set ws = ActiveSheet
    targetName = CStr(ws.Range(cellAddress).Value)

    chosen = ShowColorDialog
    If chosen = -1 Then Exit Sub

    For Each co In ws.ChartObjects
        ct = co.Chart.ChartType
        Select Case ct
            Case xlXYScatter, xlXYScatterLines, xlXYScatterLinesNoMarkers, _
                 xlXYScatterSmooth, xlXYScatterSmoothNoMarkers

                On Error Resume Next
                Set sc = co.Chart.SeriesCollection
                On Error GoTo 0
                If sc Is Nothing Then GoTo NextChart

                For i = 1 To sc.Count
                    Set s = sc.Item(i)
                    ' 完全一致のみ
                    If StrComp(CStr(s.Name), targetName, vbBinaryCompare) = 0 Then
                        ' 線色のみ変更（系列タイプ・マーカー・PlotOrder には一切触れない）
                        On Error Resume Next
                        s.Format.Line.ForeColor.RGB = chosen
                        On Error GoTo 0
                    End If
                Next i
        End Select
NextChart:
    Next co
End Sub

'==============================
' ラッパー：AB17 を対象（ボタンは一つ）
'==============================
Public Sub Change_the_ColorLine_AB17()
    ChangeColor_ScatterOnly_ColorOnly "AB17"
End Sub