Excel VBAで散布図のグラフの線の色を変えたい【VBA】

目次

経緯

VBAでプログラムを書いています。

「VBAで散布図のグラフの線の色を変えたい」

と思い、今回やってみました。

仕様

ExcelのSheetにたくさんの散布図があります。散布図には「NO1,NO2,NO3」とデータが
グラフとなっています。

セルA1に「NO1、NO2、NO3」文字が入ります。

セルA2あたりに”色変更”という図形でボタンがあります。

このボタンを押すと、パレットが出てきて、任意の色を選んで”OK”を押すと、
散布図の線の色がセルA1に入っている文字と同じ線の
色が変わります。
また、ボタンの枠の色も変わります。。

という仕様です。

コード

では、コードです。

Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    Flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lpPal As Long, lpColorRef As Long) As Long

Const CC_RGBINIT = &H1&
Const CC_FULLOPEN = &H2&
Const CC_PREVENTFULLOPEN = &H4&
Const CC_ENABLEHOOK = &H10&
Const CC_SOLIDCOLOR = &H80&
Const CC_ANYCOLOR = &H100&
Const CC_ENABLETEMPLATE = &H20&
Const CC_ENABLETEMPLATEHANDLE = &H40&

Private Function ShowColorDialog(Optional ByVal DefaultColor As Long = 0) As Long
    Dim cc As CHOOSECOLOR
    Dim CustColors As String
    Dim ColorRef As Long

    CustColors = String$(16 * 4, 0)
    With cc
        .lStructSize = Len(cc)
        .hwndOwner = Application.hwnd
        .Flags = CC_RGBINIT Or CC_FULLOPEN
        .rgbResult = DefaultColor
        .lpCustColors = CustColors
    End With

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

Sub Change_the_ColorLine()
    Dim ws As Worksheet
    Dim chartObj As ChartObject
    Dim series As Series
    Dim cellText As String
    Dim colorSelected As Long
    Dim ser As Series
    Dim shp As Shape

    ' シートとセルの指定
    Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更
    cellText = ws.Range("A1").Value

    ' カラーパレットの表示
    colorSelected = ShowColorDialog
    If colorSelected = -1 Then Exit Sub ' 色が選択されなかった場合

    ' シート内のすべてのグラフオブジェクトをループ
    For Each chartObj In ws.ChartObjects
        ' グラフのすべての系列をループ
        For Each ser In chartObj.Chart.FullSeriesCollection
            ' 系列名が一致する場合のみ処理
            If ser.Name = cellText Then
                ser.Format.Line.ForeColor.RGB = colorSelected
            End If
        Next ser
    Next chartObj

    ' ボタンの枠線の色を変更
    ' マクロを登録した図形の名前を取得
    Set shp = ActiveSheet.Shapes(Application.Caller)
    shp.Line.ForeColor.RGB = colorSelected
End Sub

こんな感じです。

この関数(マクロ)を図形で作った”色変更ボタン”にマクロ登録(Change_the_ColorLine())して、”色変更ボタン”を押してみてください。

参考になれば、幸いです。

ここまで読んでいただきありがとうございました。

スクールの紹介

最後に宣伝をさせてください。

技術で未来を切り拓く―あなたの夢を現実にするプログラミングスクール

Webデザインやプログラミングで成功を目指している方々にとって、このオンラインスクールは夢を叶えるための最適な場所です。皆さんのキャリアを次の段階へと引き上げるためにデザインされたこのスクールは、一人ひとりの成功を心から願い、それを実現するための全てを提供しています。ここでは、このスクールの魅力について詳しくご紹介します。

◆圧倒的な費用対効果
このオンラインプログラミングスクールは、Web系教育において最高の費用対効果を提供しています。多くの高額スクールが存在する中で、ここではリーズナブルな価格で、質の高い教材、無限のサポート、そして実際に市場で求められるスキルの習得機会を提供しています。

◆現役フリーランスの講師陣
講師たちは全員、現役のフリーランスプロフェッショナルです。市場で活躍している講師から直接、最新のトレンドや実践的なスキルを学べるのは、このスクールの大きな特徴です。

◆柔軟な学習コース
固定のコースがなく、学習者の興味やニーズに応じて自由に学習できます。進路変更も自由で、最低契約期間は1ヶ月という柔軟性を持っています。自分のペースで、自分に合った学習が可能です。

◆無制限の添削とサポート
理解できるまで、そして満足するまで、無制限に添削と質問への回答を提供しています。進路相談や技術面以外の相談にも対応しており、全面的にサポートします。

◆社長から学べる貴重な機会
デザイナー、プログラマー、ディレクター、マーケターとして豊富な経験を持つ社長から直接学べるのも、このスクールの特別な点です。他のスクールでは得られない、貴重な機会です。

◆実績作りへの徹底的なサポート
就職、転職、フリーランスとして成功するためには、高品質な実績が必要です。生徒の作品レベルを最大限に高め、市場で求められる実績を作り上げることに力を入れています。案件を取得できない生徒には、直接案件を提供することもあります。

◆メッセージからの約束
高額な授業料を支払わせて結果を出せないスクールとは違い、物理的なサポートは提供できないかもしれませんが、継続的な努力を通じて最高の結果を出せるようにサポートします。一緒に不正なスクールを撲滅し、あなたの夢を実現しましょう。

このプログラミングスクールは、Webデザインやプログラミングでの成功を目指す方々に必要な全てを備えています。今こそ、このコミュニティに参加し、あなたのキャリアを加速させる時です。

詳しくはこちら↓

よかったらシェアしてね!
  • URLをコピーしました!
  • URLをコピーしました!

この記事を書いた人

私が勉強したこと、実践したこと、してることを書いているブログです。
主に資産運用について書いていたのですが、
最近はプログラミングに興味があるので、今はそればっかりです。

目次