エンジニアとしての市場価値を測りませんか?PR

企業からあなたに合ったオリジナルのスカウトを受け取って、市場価値を測りましょう

1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

EXCEL VBAで綺麗な波線を書く

Last updated at Posted at 2020-04-25

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

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

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

作成される波線:
image.png

波線を書くには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

使い方

  • 1.波線を記述する範囲のセルを選択します。
    image.png

  • 2.横長の選択範囲なので、DrawWaveXのマクロを実行

  • 3.入力ダイアログが表示されますので、波の数を入力します。
    image.png

  • 4.波線が作成されます。
    image.png

応用

波線を2本作成すると、図形などの省略線の作成などができます。
image.png

1
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up

Comments

No comments

Let's comment your feelings that are more than good

Qiita Advent Calendar is held!

Qiita Advent Calendar is an article posting event where you post articles by filling a calendar 🎅

Some calendars come with gifts and some gifts are drawn from all calendars 👀

Please tie the article to your calendar and let's enjoy Christmas together!

1
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

Login to continue?

Login or Sign up with social account

Login or Sign up with your email address