EXCEL VBAで綺麗な波線を書く

# EXCELで綺麗な波線を書きたい

波線が書きたいユーザーは多いと思うのですが、、
標準の曲線ではきれいな波線が書けないですよね。

ということで、区切り線や省略記号として、きれいな波線が書きたいと思って作りました。

作成される波線：
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/191429/9dd3430a-faf5-a483-4a95-25444e92303a.png)

# 波線を書くにはVBAを使い、曲線の頂点を計算してやればいい！

曲線を作成、頂点を追加し、波線にするプログラムです。

使い方は簡単で、下記のコードをEXCEL VBAの標準モジュールファイルに張り付けて使ってください。

~~~ vb:basShape.vb
Option Explicit

Private Const MIN_KUGIRI As Double = 10.125
Public shpTmp      As Shape

'機能説明   :波の作成（縦）
'引数　　   :
'戻り値　   :
'備考　　   :
Sub DrawWaveY()
On Error GoTo ErrDrawWaveY
    Dim rngTmp      As Range
    Dim dblKugiri   As Double
    Dim dblLeft     As Double
    Dim dblTop      As Double
    Dim i           As Integer
    Dim strWave     As String
    Dim dblWave     As Double
    Dim dblFugou    As Double
  
    If TypeName(Selection) <> "Range" Then
        Exit Sub
    End If
    
    Set rngTmp = Selection
    
    strWave = InputBox("波数", "入力", 1.5)
    If Not IsNumeric(strWave) Then
        Exit Sub
    End If
    dblWave = CDbl(strWave)
    
    dblLeft = rngTmp.Left
    dblTop = rngTmp.Top
    
    dblFugou = 1
    
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, dblLeft, dblTop)
        
        dblKugiri = rngTmp.Height / (dblWave * 2)
        If dblKugiri < MIN_KUGIRI Then
            dblKugiri = MIN_KUGIRI
        End If
        
        For i = 1 To (dblWave * 2)
            dblLeft = dblLeft + (rngTmp.Width * dblFugou)
            dblTop = dblTop + dblKugiri
            
            .AddNodes msoSegmentCurve, msoEditingAuto, dblLeft, dblTop
            
            dblFugou = dblFugou * -1
        Next i
        
        Set shpTmp = .ConvertToShape

    End With
    
    shpTmp.Select
    shpTmp.Height = rngTmp.Height
    shpTmp.Width = rngTmp.Width

    Application.OnUndo "Undo test", "UndoWave"

ErrDrawWaveY:
End Sub

'機能説明   :波の作成（横）
'引数　　   :
'戻り値　   :
'備考　　   :
Sub DrawWaveX()
On Error GoTo ErrDrawWaveX
    Dim rngTmp      As Range
    Dim dblKugiri   As Double
    Dim dblLeft     As Double
    Dim dblTop      As Double
    Dim i           As Integer
    Dim strWave     As String
    Dim dblWave     As Double
    Dim dblFugou    As Double
    
    If TypeName(Selection) <> "Range" Then
        Exit Sub
    End If
    
    Set rngTmp = Selection
    
    strWave = InputBox("波数", "入力", 1.5)
    If Not IsNumeric(strWave) Then
        Exit Sub
    End If
    dblWave = CDbl(strWave)
    
    dblLeft = rngTmp.Left
    dblTop = rngTmp.Top
    
    dblFugou = 1
    
    
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, dblLeft, dblTop)
        
        dblKugiri = rngTmp.Width / (dblWave * 2)
        If dblKugiri < MIN_KUGIRI Then
            dblKugiri = MIN_KUGIRI
        End If
        
        For i = 1 To (dblWave * 2)
            dblTop = dblTop + (rngTmp.Height * dblFugou)
            dblLeft = dblLeft + dblKugiri
            
            .AddNodes msoSegmentCurve, msoEditingAuto, dblLeft, dblTop
            
            dblFugou = dblFugou * -1
        Next i
        
        Set shpTmp = .ConvertToShape
        
    End With
    
    shpTmp.Select
    shpTmp.Height = rngTmp.Height
    shpTmp.Width = rngTmp.Width

    Application.OnUndo "Undo test", "UndoWave"
ErrDrawWaveX:
End Sub
~~~

# 使い方

- １．波線を記述する範囲のセルを選択します。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/191429/dddefbef-c8e2-b038-81b3-0fe974dc3067.png)

- ２．横長の選択範囲なので、DrawWaveXのマクロを実行

- ３．入力ダイアログが表示されますので、波の数を入力します。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/191429/037d03c2-7b8a-1c6a-1c65-68f90dd56fc5.png)

- ４．波線が作成されます。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/191429/a79bfdc9-cd4d-85b7-06da-ba24538bbc87.png)

# 応用

波線を2本作成すると、図形などの省略線の作成などができます。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/191429/e1b3350b-4bfa-24f8-5aa7-e3ddfaae78c4.png)