EXCELで綺麗な波線を書きたい
波線が書きたいユーザーは多いと思うのですが、、
標準の曲線ではきれいな波線が書けないですよね。
ということで、区切り線や省略記号として、きれいな波線が書きたいと思って作りました。
波線を書くにはVBAを使い、曲線の頂点を計算してやればいい!
曲線を作成、頂点を追加し、波線にするプログラムです。
使い方は簡単で、下記のコードをEXCEL VBAの標準モジュールファイルに張り付けて使ってください。
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
Comments
Let's comment your feelings that are more than good