波線を作る

オートシェイプを自分で自由に書ける！

Sub 波線作成テスト()
    
    Dim myShape As Shape
    Dim ffb As FreeformBuilder
    
    Dim r As Range
    Set r = Range("A3")
    
    Set ffb = Shapes.BuildFreeform(msoEditingAuto, r.Left, r.Top)
    
    Dim i As Integer
    For i = 1 To 3
        
        Set r = r.Offset(-1, 1)
        ffb.AddNodes msoSegmentCurve, msoEditingAuto, r.Left, r.Top
        
        Set r = r.Offset(1, 1)
        ffb.AddNodes msoSegmentCurve, msoEditingAuto, r.Left, r.Top
        
    Next
    
    Set myShape = ffb.ConvertToShape '作成

    With myShape.Line
        .DashStyle = msoLineSolid
        .Weight = 3
        .ForeColor.RGB = rgbDarkRed
    End With

End Sub

曲線はmsoSegmentCurve、直線はmsoSegmentLineに書き換える。

ffb.AddNodes msoSegmentLine, msoEditingAuto, r.Left, r.Top

開始地点と終了地点を結ぶと、普通のオートシェイプの様に塗りつぶしなど自由自在。
直線と曲線の混在も可能。扇型を4つ作って重ねてみた。三角関数！

Excel標準のオートシェイプでも扇型は作れるけど、上記の様には作れないはず。

以上。

入力候補の表示（Ctrl+Space）

VBEでコーディングする際、入力候補はドットやCtrl+Spaceを押すと出てくる。

以上。

商と余り

ド忘れしてたのでメモ。

￥ 商
Mod 余り

Debug.Print 10 / 3 '3.33...
Debug.Print 10 ￥ 3 '3
Debug.Print 10 Mod 3 '1

Debug.Print Int(10 / 3) '3
Debug.Print Fix(10 / 3) '3
Debug.Print Int(-10 / 3) '-4
Debug.Print Fix(-10 / 3) '-3

以上。

同心の円を連続作成

こんなの作りたい。

円の中心位置と直径から図形のサイズを計算してオートシェイプを作成。

Sub テスト()
    
    Dim 中心点Left As Integer
    Dim 中心点Top As Integer
    中心点Left = Range("E15").Left
    中心点Top = Range("E15").Top
    
    Dim 直径 As Integer
    For 直径 = 60 To 300 Step 60
        Call オートシェイプ楕円(中心点Left, 中心点Top, 直径)
    Next
    
End Sub

Sub オートシェイプ楕円(中心点Left, 中心点Top, 直径, _
                        Optional iLineColor As Long = rgbBlack, _
                        Optional iForeColor As Long = rgbWhite)
    
    Dim 開始位置Left As Integer
    Dim 開始位置Top As Integer
    開始位置Left = 中心点Left - (直径 / 2)
    開始位置Top = 中心点Top - (直径 / 2)
    
    Dim myShape As Shape
    Set myShape = Shapes.AddShape(msoShapeOval, 開始位置Left, 開始位置Top, 直径, 直径)
    
    myShape.Line.ForeColor.RGB = iLineColor '外枠
    myShape.Fill.ForeColor.RGB = iForeColor '塗りつぶし色
    'myShape.Fill.Visible = msoFalse '塗りつぶし無し
    
    Set myShape = Nothing
    
End Sub

同心の円を小さい順に作ると、後に作られた円に隠れてしまう。大きい円から作ればいいのだが、せっかくなので順番を変える処理を作成。
作った円はグループ化。ついでにオートシェイプ全削除処理も作成。

Sub オートシェイプ順番変更()
    Dim myShape As Shape
    For Each myShape In Shapes
        myShape.ZOrder msoSendToBack '最背面へ移動
    Next
    Set myShape = Nothing
End Sub

Sub オートシェイプグループ化()
    ActiveSheet.Shapes.SelectAll
    Selection.ShapeRange.Group.Name = "test"
End Sub

Sub オートシェイプ全削除()
    Dim myShape As Shape
    For Each myShape In Shapes
        myShape.Delete
    Next
    Set myShape = Nothing
End Sub

以下、完成品。
オートシェイプ全削除と全グループ化が行われます。取扱注意。

Sub アーチェリー的()
    
    Call オートシェイプ全削除
    
    Dim 中心点Left As Integer
    Dim 中心点Top As Integer
    中心点Left = Range("E15").Left
    中心点Top = Range("E15").Top
    
    Call オートシェイプ楕円(中心点Left, 中心点Top, 10, , rgbYellow)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 20, , rgbYellow)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 30, , rgbRed)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 40, , rgbRed)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 50, , rgbBlue)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 60, , rgbBlue)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 70, , rgbGray)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 80, , rgbGray)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 90)
    Call オートシェイプ楕円(中心点Left, 中心点Top, 100)
    
    Call オートシェイプ順番変更
    Call オートシェイプグループ化
    
End Sub

オートシェイプの順番を変える ZOrder

値	定数	内容
0	msoBringToFront	最前面へ移動
1	msoSendToBack	最背面へ移動
2	msoBringForward	前面へ移動
3	msoSendBackward	背面へ移動
4	msoBringInFrontOfText	図形をテキストの前に移動（Word）
5	msoSendBehindText	図形をテキストの後ろに移動（Word）

以上。

If 1<2<3 Then

文法エラーにならない。怖い。

If 1 < 2 < 3 Then
    Debug.Print "1.True"
End If

If 3 < 2 < 1 Then
    Debug.Print "2.True"
End If

If True > True > True Then
    Debug.Print "3.True"
End If

順番に一つ一つ比較する。
1の例。1<2はTrue、Int(True)は-1、-1<3はTrue。
2の例。3<2はFalse、Int(False)は0、0<3はTrue。
3の例。Int(True)は-1、-1>-1はFalse、Int(False)は0、0>-1はTrue。

正しく動いても怖い。

以上。

For Eachの処理順番

順番は保証されてない模様。以下、確認用コード。

Set セル範囲 = Range("A1:E2")

For Each v In セル範囲
    Debug.Print v
Next

二次元配列 = セル範囲

For Each d In 二次元配列
    Debug.Print d
Next

テスト表

＼	A	B	C	D	E
1	1	2	3	4	5
2	6	7	8	9	10

実行結果
セル範囲の出力結果 1,2,3,4,5,6,7,8,9,10
二次元配列の出力結果 1,6,2,7,3,8,4,9,5,10

For Eachでセル範囲と配列をブン回してみると、セル範囲は行単位で処理され、配列は列単位で処理されている。ここでは細かい挙動の確認は行わない。扱うものによって処理順番が変わることだけ分かればヨシ。

処理される順番が変わるのが嫌ならば、以下の様に組めばガチガチ安心。

Dim i As Long, j As Long
For i = LBound(二次元配列, 1) To UBound(二次元配列, 1)
    For j = LBound(二次元配列, 2) To UBound(二次元配列, 2)
        Debug.Print 二次元配列(i, j)
    Next
Next

以上。

ヘッダーを除いたセル範囲を取得

セルC7にてCtrl+Aで取得できる範囲から、Offsetで一行下げて、Resizeで一行減らす。

Dim セル範囲 As Range
With Range("C7").CurrentRegion
    Set セル範囲 = .Offset(1).Resize(.Rows.Count - 1)
End With

以上。