PowerPoint VBA 折れ線グラフを散布図に変更して、軸の書式設定を行う

きっかけ

先日PowerPointのスライド200枚の中にある折れ線グラフ約250個に対して、以下の作業をする機会があった。

各折れ線グラフに対して
(1) グラフの種類を折れ線から散布図に変更
(2) 横軸の最大値、最小値を設定

更に、一つのスライドに存在する折れ線グラフの数によって処理が異なり、
(1) グラフが1つの場合
・目盛り幅を4に設定

(2) グラフが2つ以上の場合
・目盛り幅を8に設定
・補助目盛り幅を4に設定
・補助目盛りの種類を目盛りと同じものに設定

サンプルコード

Sub Main()
    Dim s As slide
    Dim lineCharts As Collection, chart As Variant
    For Each s In ActivePresentation.Slides
        Set lineCharts = 折れ線グラフを取得(s) 
        For Each chart In lineCharts
            Call 折れ線グラフを散布図に変換(chart, lineCharts.Count)
        Next chart
    Next s
End Sub

Sub 折れ線グラフを散布図に変換(chart As Variant, chart_num As Long)
    Dim shp As Shape: Set shp = chart
    Dim xAxis As Axis: Set xAxis = shp.chart.Axes(1)
    shp.chart.ChartType = xlXYScatterLines
    xAxis.MinimumScale = 0
    xAxis.MaximumScale = 96
    If chart_num = 1 Then
        xAxis.MajorUnit = 4
    Else
        xAxis.MajorUnit = 8
        xAxis.MinorTickMark = xAxis.MajorTickMark
        xAxis.MinorUnit = 4
    End If
End Sub

Function 折れ線グラフを取得(s As slide) As Collection
    Dim ret As Collection: Set ret = New Collection
    Dim shp As Shape
    For Each shp In s.Shapes
        If shp.HasChart Then
            If shp.chart.ChartType = xlLineMarkers Then ret.Add shp 
        End If
    Next shp
    Set 折れ線グラフを取得 = ret
End Function

Excel VBAやAccess VBAと勝手が異なり苦労した。
細かな処理は別プロシージャ化して、なるべくMainのプロシージャが簡潔になるようにした。
改善点は色々あると思うが、とりあえずやりたいことは出来たので、これでよしとしよう。

VBA 文字列の一部分を取得する関数を作る

きっかけ

いつも勉強させてもらっている伊藤先生のサイトで、面白い記事があった。
ByRef・参照渡しとはどう使うのか:エクセルマクロ・Excel VBAの使い方

サンプルコード

戻り値が配列の場合

Function 文字列から要素数2の配列を取得(ByVal code As String) As String()
    Dim ret(1) As String
    ret(0) = Mid(code, 1, 4)
    ret(1) = Mid(code, 5, 6)
    文字列から要素数2の配列を取得 = ret
End Function

イミディエイトウインドウでテストすると下記のようになる

? 文字列から要素数2の配列を取得("abcd012345")(0)
abcd
? 文字列から要素数2の配列を取得("abcd012345")(1)
012345

戻り値が文字列の場合

Function 2つに分割した文字列を取得(ByVal code As String, num As Long) As String
    Dim ret As String
    Select Case num
        Case 0: ret = Mid(code, 1, 4)
        Case 1: ret = Mid(code, 5, 6)
        Case Else: ret = "ERROR"
    End Select
    2つに分割した文字列を取得 = ret
End Function

なお、0,1以外が入力された場合は"ERROR"を返すようにした。
前半を0、後半を1、というのは分かりにくいな。。
仮引数名が「num」というのもいまいちだが、、

イミディエイトウインドウでテストすると下記のようになる

? 2つに分割した文字列を取得("abcd012345",0)
abcd
? 2つに分割した文字列を取得("abcd012345",1)
012345
? 2つに分割した文字列を取得("abcd012345",-10)
ERROR

AccessVBA フォームのFilterプロパティに設定する文字列を生成する関数

初めに

先日、レコードを一覧表示するフォームに検索用のテキストボックスを追加し、その入力内容でフィルタをかける、という機能を作った。
例えばこんな感じ

Me.Filter= "入社年 > 2015 and 部署 = A事業部 and 性別 = 男"
Me.Fiter=True

このFilterプロパティに設定する文字列
"入社年 > 2015 and 部署 = A事業部 and 性別 = 男"
を生成する関数を作った。
（正確に言うと自分の力では作れず、私の先生の力を大いに借りたのだが、、）

サンプルコード

Function Combine(condition1 As String, condition2 As String, condition3 As String) As String
    Combine = Join(Array(condition1, condition2, condition3), " and ")
End Function

これをイミディエイトウィンドウ上で実行すると
?combine("cond1","cond2","cond3")
cond1 and cond2 and cond3
となった。

今は引数の数が固定なので、任意の数の引数に対応するようにしたい。改良したのが次のコード。

Function Combine(ParamArray conditions()) As String
    Dim ret As String
    Dim i As Long
    For i = LBound(conditions) To UBound(conditions)
        ret = ret & " and " & conditions(i)
    Next i
    Combine = ret
End Function

これを実行すると
?combine("cond1","cond2")
and cond1 and cond2

?combine("cond1","cond2","cond3")
and cond1 and cond2 and cond3

と引数の数の変化には対応出来たが、先頭に" and "が入ってしまった。それを削除したのが次のコード

Function Combine(ParamArray conditions()) As String
    Dim ret As String
    Dim i As Long
    For i = LBound(conditions) To UBound(conditions)
        ret = ret & " and " & conditions(i)
    Next i
    Combine = Mid(ret, Len(" and ") + 1)
End Function

実行すると
?combine("cond1","cond2")
cond1 and cond2

?combine("cond1","cond2","cond3")
cond1 and cond2 and cond3

と先頭の" and "が削除された。更に区切り文字 " and "も引数にしたのが次のコード。

Function Combine(delimiter As String, ParamArray conditions()) As String
    Dim ret As String
    Dim i As Long
    For i = LBound(conditions) To UBound(conditions)
        ret = ret & delimiter & conditions(i)
    Next i
    Combine = Mid(ret, Len(delimiter) + 1)
End Function

実行すると
?combine(" and ","cond1","cond2","cond3")
cond1 and cond2 and cond3
となった。

ただし、今の関数だと引数が空文字列の場合
?combine(" and ","cond1","","cond3")
cond1 and and cond3
?combine(" and ","","cond2","cond3")
and cond2 and cond3

のように不要なandが含まれてしまう。引数に空文字列が与えられた場合（つまり検索条件の指定が無かった場合）スキップするように改良したのが次のコード

Function Combine(delimiter As String, ParamArray conditions()) As String
    Dim ret As String
    Dim i As Long
    For i = LBound(conditions) To UBound(conditions)
        If conditions(i) <> "" Then ret = ret & delimiter & conditions(i)
    Next i
    Combine = Mid(ret, Len(delimiter) + 1)
End Function

実行すると
?combine(" and ","cond1","","cond3")
cond1 and cond3
?combine(" and ","","cond2","cond3")
cond2 and cond3
と余計なandが入っていない。これで一応欲しい機能が実現出来たようだ。だが、きちんと動作確認するには単体テストが必要で、それは後日書こうと思う。

最後に

生まれて初めてブログを書いた。ブログを書くのがこんなに難しいとは思わなかった。文章を書く良い訓練になるので、今後も自分が勉強したことを少しずつ書いていこうと思う。
また、シンタックスハイライトが出来なくて困ったが、こちらの記事を見て解決した。ありがとうございます！
k01ken.hatenablog.com