VBAプログラム例

プログラム例

現在のシートを選択
Set ws = ActiveSheet

Function GetActiveChart() As Chart
On Error Resume Next                   ' エラーが起きても実行継続
Set GetActiveChart = ActiveChart
On Error GoTo 0                           ' 上のエラーハンドリングを無効化し、デフォルトのエラーハンドラに戻す

If GetActiveChart Is Nothing Then
    MsgBox "アクティブなチャートが選択されていません。", vbExclamation
End If
End Function
セルの取得
ws.Rnage("A1")
セルの値の変更
ws.Rnage("A1").Value = value
名前を付けたセルの値の取得:
Set path_range = ThisWorkbook.Names("ｐａｔｈ").RefersToRange
path_range.value で取得
セルのフォントの変更
ws.Rnage("A1").font.Name = 'MS 明朝' ' 他に "MS ゴシック"、'Arial'、"Times New Roman"、など
列幅の自動調整
ws.Columns("A").AutoFit

グラフオブジェクトを取得:
Dim cht As ChartObject
Dim s As Series
Set cht = ws.ChartObjects(1)
アクティブなグラフオブジェクトを取得:
Function GetActiveChart() As Chart
    On Error Resume Next
    Set GetActiveChart = ActiveChart
    On Error GoTo 0

    If GetActiveChart Is Nothing Then
        MsgBox "アクティブなチャートが選択されていません。", vbExclamation
    End If
End Function
シェルを使った外部プログラムの実行:
Windows:
Shell cmd, vbNormalFocus
macOS:
AppleScript (osascriptコマンド) を呼び出してterminalを実行するそうです。コードは未掲載
ファイルパスからディレクトリパスを取得:
dirPath = Left(filePath, InStrRev(filePath, "\"))
入力ダイアログ:
args = InputBox("plot_exce.pyの引数:", "入力ダイアログ", args & " " & datemin)
' キャンセルが押された場合、関数を中断
If args = "" Then
MsgBox "キャンセルされました。"
End If
別ファイルのVBAをインポート:
Set vbProj = ThisWorkbook.VBProject
vbProj.VBComponents.Import "C:\path\to\module.bas"
別ファイル xlsm のVBAをインポート:
Dim wb As Workbook
Set wb = Workbooks.Open("C:\path\to\otherWorkbook.xlsm")
' 他のブックのマクロを実行
Application.Run "otherWorkbook.xlsm!MacroName"

Sub SetFontExample()
    Dim ws As Worksheet
    Set ws = ActiveSheet  ' 現在のシートを指定

    ' 明朝フォント
    ws.Range("A1").Value = "明朝フォント"
    ws.Range("A1").font.Name = "MS 明朝"

    ' ゴシックフォント
    ws.Range("A2").Value = "ゴシックフォント"
    ws.Range("A2").font.Name = "MS ゴシック"

    ' Times New Roman
    ws.Range("A3").Value = "Times New Roman"
    ws.Range("A3").font.Name = "Times New Roman"

    ' Arial
    ws.Range("A4").Value = "Arial"
    ws.Range("A4").font.Name = "Arial"

    ' 列幅を自動調整
    ws.Columns("A").AutoFit
End Sub

Sub MoveLegendToTopInsidePlotArea()
    Dim ch As Chart

    ' アクティブなチャートを取得
    Set ch = GetActiveChart()

    ' チャートが存在する場合
    If Not ch Is Nothing Then
        ' プロットエリア内に凡例を移動
        With ch.Legend
            .Position = xlLegendPositionTop
            .Top = ch.PlotArea.Top + 10 ' プロットエリア内の上部に移動
            .Left = ch.PlotArea.Left + (ch.PlotArea.Width - .Width) / 2 ' プロットエリアの中央に配置
        End With
    End If

    ' メッセージを表示
    MsgBox "凡例の位置をプロットエリア内の上部に移動しました。", vbInformation
End Sub

Sub AddAxisLabels()
    Dim ch As Chart

    ' アクティブなチャートを取得
    Set ch = GetActiveChart()

    ' チャートが存在する場合
    If Not ch Is Nothing Then
        ' X軸ラベルを追加
        With ch.Axes(xlCategory, xlPrimary)
            .HasTitle = True
            .AxisTitle.Text = "X軸ラベル"
            .AxisTitle.font.Size = 16
            .AxisTitle.Orientation = xlHorizontal
            .AxisTitle.Top = ch.PlotArea.InsideHeight + ch.PlotArea.InsideTop + 10
            .AxisTitle.Left = ch.PlotArea.InsideLeft + (ch.PlotArea.InsideWidth - .AxisTitle.Width) / 2
        End With

        ' Y軸ラベルを追加
        With ch.Axes(xlValue, xlPrimary)
            .HasTitle = True
            .AxisTitle.Text = "Y軸ラベル"
            .AxisTitle.font.Size = 16
            .AxisTitle.Orientation = xlHorizontal ' 横書きに設定
            .AxisTitle.Orientation = xlUpward ' 90度回転
            .AxisTitle.Top = ch.PlotArea.InsideTop + (ch.PlotArea.InsideHeight - .AxisTitle.Width) / 2
            .AxisTitle.Left = ch.PlotArea.InsideLeft - .AxisTitle.Height - 10
        End With
    End If

    ' メッセージを表示
    MsgBox "プロットエリアの位置を調整し、X軸ラベルとY軸ラベルを追加しました。", vbInformation
End Sub

Sub AdjustPlotAreaAndAddAxisLabels()
    Dim ch As Chart

    ' アクティブなチャートを取得
    Set ch = GetActiveChart()

    ' チャートが存在する場合
    If Not ch Is Nothing Then
        ' プロットエリアの位置を調整
        With ch.PlotArea
            .Left = ch.chartArea.Width * 0.15
            .Top = ch.chartArea.Height * 0.1
            .Width = ch.chartArea.Width * 0.7
            .Height = ch.chartArea.Height * 0.7
        End With

        ' X軸ラベルを追加
        With ch.Axes(xlCategory, xlPrimary)
            .HasTitle = True
            .AxisTitle.Text = "X軸ラベル"
            .AxisTitle.font.Size = 16
            .AxisTitle.Orientation = xlHorizontal
            .AxisTitle.Top = ch.PlotArea.InsideHeight + ch.PlotArea.InsideTop + 10
            .AxisTitle.Left = ch.PlotArea.InsideLeft + (ch.PlotArea.InsideWidth - .AxisTitle.Width) / 2
        End With

        ' Y軸ラベルを追加
        With ch.Axes(xlValue, xlPrimary)
            .HasTitle = True
            .AxisTitle.Text = "Y軸ラベル"
            .AxisTitle.font.Size = 16
            .AxisTitle.Orientation = xlVertical
            .AxisTitle.Top = ch.PlotArea.InsideTop + (ch.PlotArea.InsideHeight - .AxisTitle.Height) / 2
            .AxisTitle.Left = ch.PlotArea.InsideLeft - .AxisTitle.Width - 10
        End With
    End If

    ' メッセージを表示
    MsgBox "プロットエリアの位置を調整し、X軸ラベルとY軸ラベルを追加しました。", vbInformation
End Sub

Sub ChangeLineWidth()
    Dim ch As Chart
    Dim ax As Axis

    ' アクティブなチャートを取得
    Set ch = GetActiveChart()

    ' チャートが存在する場合
    If Not ch Is Nothing Then
        ' プロットエリアの枠線の幅を2、色を黒に設定
        With ch.PlotArea.Format.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Weight = 2
        End With

        ' X軸とY軸の設定
        For Each ax In ch.Axes
            With ax
                ' 主目盛線を"線無し"に設定
                .HasMajorGridlines = False

                ' 目盛りの種類を"内向き"に設定
                .TickLabelPosition = xlTickLabelPositionNextToAxis
                .MajorTickMark = xlTickMarkInside
                .MinorTickMark = xlTickMarkInside

                ' 軸の線を"線（単色）"、色を黒、幅を1.5に設定
                With .Format.Line
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 0, 0)
                    .Weight = 1.5
                End With
            End With
        Next ax
    End If

    ' メッセージを表示
    MsgBox "チャートのカスタマイズが完了しました。", vbInformation
End Sub

Sub RemoveChartAndPlotAreaFill()
    Dim ch As Chart

    ' アクティブなチャートを取得
    Set ch = GetActiveChart()

    ' チャートが存在する場合、グラフエリアとプロットエリアの塗りつぶしを「なし」に設定
    If Not ch Is Nothing Then
        ' グラフエリアの塗りつぶしを「なし」に設定
        With ch.chartArea.Format.Fill
            .Visible = msoFalse
        End With

        ' プロットエリアの塗りつぶしを「なし」に設定
        With ch.PlotArea.Format.Fill
            .Visible = msoFalse
        End With
    End If

    ' メッセージを表示
    MsgBox "グラフエリアとプロットエリアの塗りつぶしをなしにしました。", vbInformation
End Sub

Sub ChangeFont()
    Dim ch As Chart
    Dim sr As series
    Dim ax As Axis
    Dim dl As DataLabel
    Dim lg As LegendEntry
    Dim FontColor As Long
    Dim FontName As String
    
    FontName = "Arial"
    FontColor = RGB(0, 0, 0)

    ' アクティブグラフを取得
    On Error Resume Next
    Set ch = GetActiveChart()
    On Error GoTo 0

    ' グラフが選択されているか確認
    If ch Is Nothing Then
        MsgBox "グラフが選択されていません。", vbExclamation
        Exit Sub
    End If

    ' グラフのフォントを設定
    With ch
        ' グラフタイトルのフォント設定
        If .HasTitle Then
            ch.ChartTitle.Format.Fill.Visible = msoFalse   ' 塗りつぶし無しに設定
'            ch.ChartTitle.Format.Fill.Solid
'            ch.ChartTitle.Format.Fill.ForeColor.RGB = RGB(255, 255, 255) ' 白色に設定
'            ch.ChartTitle.Format.Fill.Transparency = 1 ' 透明に設定
            With .ChartTitle.font
                .Name = FontName
                .Size = 16
                .color = FontColor
                .Bold = True
            End With
        End If

        ' X軸とY軸の目盛りラベルのフォント設定
        For Each ax In .Axes
            With ax.TickLabels.Format.Fill
                .Visible = msoFalse    ' 塗りつぶし無し
            End With
            
            With ax.TickLabels.font
                .Name = FontName
                .Size = 16
                .color = FontColor
                .Bold = True
            End With
        Next ax

        ' X軸とY軸のタイトルのフォント設定
        For Each ax In .Axes
            With ax.TickLabels.Format.Fill
                .Visible = msoFalse   ' 塗りつぶし無し
            End With
            If ax.HasTitle Then
                With ax.AxisTitle.font
                    .Name = FontName
                    .Size = 16
                    .color = FontColor
                    .Bold = True
                End With
            End If
        Next ax

        ' データラベルのフォント設定
        For Each sr In .SeriesCollection
            If sr.HasDataLabels Then
                For Each dl In sr.DataLabels
                    With dl.font
                        .Name = FontName
                        .Size = 16
                        .color = FontColor
                        .Bold = True
                    End With
                Next dl
            End If
        Next sr

        ' 各系列のデータラベルの塗りつぶしを「なし」に設定
            For Each series In ch.SeriesCollection
                 If series.HasDataLabels Then
                     For Each Point In series.Points
                         Point.DataLabel.Format.Fill.Visible = msoFalse
                     Next Point
                 End If
             Next series
        
        ' 凡例のフォント設定
        If .HasLegend Then
            ch.Legend.Format.Fill.Visible = msoFalse  ' 塗りつぶし無し
            
            For Each lg In .Legend.LegendEntries
                With lg.font
                    .Name = FontName
                    .Size = 16
                    .color = FontColor
                    .Bold = True
                End With
            Next lg
        End If
    End With

    ' メッセージを表示
    MsgBox "グラフのフォント設定が完了しました。", vbInformation
End Sub

Sub ChangeScaleBars()
    Dim ch As Chart
    Dim ax As Axis

    ' アクティブグラフを取得
    On Error Resume Next
    Set ch = ActiveChart
    On Error GoTo 0

    ' グラフが選択されているか確認
    If ch Is Nothing Then
        MsgBox "グラフが選択されていません。", vbExclamation
        Exit Sub
    End If

    ' グラフのフォーマット設定
    With ch
        ' プロットエリアの塗りつぶしを「なし」に設定
        .PlotArea.Format.Fill.Visible = msoFalse

        ' X軸とY軸の目盛り線の設定
        For Each ax In .Axes
            With ax
                ' 主目盛り線の設定
                .MajorTickMark = xlInside
                .MajorGridlines.Format.Line.Weight = 1 ' 主目盛り線の太さ
                .MajorGridlines.Format.Line.DashStyle = msoLineSolid ' 実線に設定
                .MajorGridlines.Format.Line.ForeColor.RGB = RGB(0, 0, 0) ' 色を黒に設定
'                .MajorGridlines.Format.Line.Visible = msoTrue ' プロットエリア全体を横切らないように設定

                ' 副目盛り線の設定
                .MinorTickMark = xlInside
                .MinorGridlines.Format.Line.Weight = 0.5 ' 副目盛り線の太さ
                .MinorGridlines.Format.Line.DashStyle = msoLineSolid ' 実線に設定
                .MinorGridlines.Format.Line.ForeColor.RGB = RGB(0, 0, 0) ' 色を黒に設定
                .MinorGridlines.Format.Line.Visible = msoTrue ' プロットエリア全体を横切らないように設定
            End With
        Next ax

        ' プロットエリアの枠線の太さを2、色を黒に設定
        With .PlotArea.Format.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Weight = 2
        End With

        ' 外枠の線の太さを1に設定
        With .chartArea.Format.Line
            .Visible = msoTrue
            .Weight = 1
            .Transparency = 1 ' 外枠の線を完全に透明に設定
        End With
    End With

    ' メッセージを表示
    MsgBox "グラフのフォーマット設定が完了しました。", vbInformation
End Sub

Sub RemoveMajorGridlines()
    Dim ch As Chart
    Dim ax As Axis

    ' アクティブグラフを取得
    On Error Resume Next
    Set ch = ActiveChart
    On Error GoTo 0

    ' グラフが選択されているか確認
    If ch Is Nothing Then
        MsgBox "グラフが選択されていません。", vbExclamation
        Exit Sub
    End If

    ' X軸とY軸の主目盛り線を非表示にする
    With ch
        For Each ax In .Axes
            If ax.Type = xlCategory Or ax.Type = xlValue Then
                ax.HasMajorGridlines = False
            End If
        Next ax
    End With

    ' メッセージを表示
    MsgBox "X軸とY軸の主目盛り線が非表示になりました。", vbInformation
End Sub


Sub AdjustChartLayout()
    Dim ch As Chart

    ' アクティブグラフを取得
    On Error Resume Next
    Set ch = ActiveChart
    On Error GoTo 0

    ' グラフが選択されているか確認
    If ch Is Nothing Then
        MsgBox "グラフが選択されていません。", vbExclamation
        Exit Sub
    End If

    ' グラフのフォーマット設定
    With ch
        ' グラフタイトルを削除
        .HasTitle = False

        ' 凡例をプロットエリアの内部に移動
        .Legend.Position = xlLegendPositionTop
        .Legend.Format.Fill.Transparency = 1
        .Legend.font.Size = 16

        ' プロットエリアのサイズと位置を調整
        .PlotArea.Width = .chartArea.Width * 0.8
        .PlotArea.Height = .chartArea.Height * 0.7
        .PlotArea.Left = .chartArea.Width * 0.1
        .PlotArea.Top = .chartArea.Height * 0.1

        ' X軸ラベルを追加
        With .Axes(xlCategory, xlPrimary)
            .HasTitle = True
            .AxisTitle.Text = "X"
            .AxisTitle.font.Size = 16
            .TickLabels.font.Size = 16
        End With

        ' Y軸ラベルを追加
        With .Axes(xlValue, xlPrimary)
            .HasTitle = True
            .AxisTitle.Text = "Y"
            .AxisTitle.font.Size = 16
            .TickLabels.font.Size = 16
        End With

        ' 全ての系列データラベルのフォントサイズを設定
        Dim sr As series
        For Each sr In .SeriesCollection
            If sr.HasDataLabels Then
                sr.DataLabels.font.Size = 16
            End If
        Next sr
    End With

    ' メッセージを表示
    MsgBox "グラフのレイアウト設定が完了しました。", vbInformation
End Sub

Sub CustomizeActiveChart()
    Dim cht As Chart
    
    ' アクティブなグラフを取得
    Set cht = ActiveChart
    If cht Is Nothing Then
        MsgBox "グラフが選択されていません！", vbExclamation
        Exit Sub
    End If

    With cht
        ' グラフの背景を透明に
        .chartArea.Format.Fill.Visible = msoFalse
        .PlotArea.Format.Fill.Visible = msoFalse

        ' X軸の設定
        With .Axes(xlCategory)
            .HasTitle = True
            .AxisTitle.Text = "X軸 (単位)"
            .AxisTitle.font.Size = 14
            .TickLabels.font.Size = 12
            .MajorGridlines.Format.Line.Visible = msoTrue
            .MajorGridlines.Format.Line.ForeColor.RGB = RGB(200, 200, 200)
        End With

        ' Y軸の設定
        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Text = "Y軸 (単位)"
            .AxisTitle.font.Size = 14
            .TickLabels.font.Size = 12
            .MajorGridlines.Format.Line.Visible = msoTrue
            .MajorGridlines.Format.Line.ForeColor.RGB = RGB(200, 200, 200)
        End With

        ' 凡例の調整
        .HasLegend = True
        .Legend.Position = xlLegendPositionBottom
        .Legend.font.Size = 12

        ' タイトルの設定
        .HasTitle = True
        .ChartTitle.Text = "学会向けグラフ"
        .ChartTitle.font.Size = 16

        ' データ系列の設定
        Dim s As series
        For Each s In .SeriesCollection
            s.MarkerStyle = xlMarkerStyleCircle
            s.MarkerSize = 8
            s.MarkerForegroundColor = RGB(0, 0, 0)
            s.MarkerBackgroundColor = RGB(255, 255, 255)
            s.Format.Line.Visible = msoTrue
            s.Format.Line.ForeColor.RGB = RGB(0, 0, 0)
            s.Format.Line.Weight = 1
        Next s
    End With

    ' 完了メッセージ
    MsgBox "グラフが整形されました！", vbInformation
End Sub

Sub CustomizeAllChartsOnSheet()
    Dim ws As Worksheet
    Dim chtObj As chartObject
    
    ' アクティブシートを取得
    Set ws = ActiveSheet
    
    ' シート内のすべてのグラフを処理
    For Each chtObj In ws.ChartObjects
        CustomizeChart chtObj.Chart
    Next chtObj
    
    MsgBox "シート内のすべてのグラフを整形しました！", vbInformation
End Sub

' 共通のグラフ整形処理
Sub CustomizeChart(cht As Chart)
    With cht
        ' グラフの背景を透明に
        .chartArea.Format.Fill.Visible = msoFalse
        .PlotArea.Format.Fill.Visible = msoFalse

        ' X軸の設定
        With .Axes(xlCategory)
            .HasTitle = True
            .AxisTitle.Text = "X軸 (単位)"
            .AxisTitle.font.Size = 14
            .TickLabels.font.Size = 12
            .MajorGridlines.Format.Line.Visible = msoTrue
            .MajorGridlines.Format.Line.ForeColor.RGB = RGB(200, 200, 200)
        End With

        ' Y軸の設定
        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Text = "Y軸 (単位)"
            .AxisTitle.font.Size = 14
            .TickLabels.font.Size = 12
            .MajorGridlines.Format.Line.Visible = msoTrue
            .MajorGridlines.Format.Line.ForeColor.RGB = RGB(200, 200, 200)
        End With

        ' 凡例の調整
        .HasLegend = True
        .Legend.Position = xlLegendPositionBottom
        .Legend.font.Size = 12

        ' タイトルの設定
        .HasTitle = True
        .ChartTitle.Text = "学会向けグラフ"
        .ChartTitle.font.Size = 16

        ' データ系列の設定
        Dim s As series
        For Each s In .SeriesCollection
            s.MarkerStyle = xlMarkerStyleCircle
            s.MarkerSize = 8
            s.MarkerForegroundColor = RGB(0, 0, 0)
            s.MarkerBackgroundColor = RGB(255, 255, 255)
            s.Format.Line.Visible = msoTrue
            s.Format.Line.ForeColor.RGB = RGB(0, 0, 0)
            s.Format.Line.Weight = 1
        Next s
    End With
End Sub