文字に○をつけるVBA【サンプル事例を使ってVBAの導入方法を紹介】

マメ父ちゃん

2022年4月17日 22:24

セルに入力された文字に図形の○をつけるVBAについて解説していきます。

アンケート形式の書類では「はい」、「いいえ」、「有」、「無」に○を付ける処理が必要になります。

この記事で紹介している文字に○をつけるVBAを設定すると、○を付ける処理を自動化することができます。

アンケート形式の書類作成が多いという方におすすめのVBAなので、自由に扱えるようになりましょう。

文字に○をつけるVBAとは？

文字に○をつけるVBAとは、図形○を挿入するVBAを使って、セルに入力されたテキストに図形○つける処理を自動化する！というものです。

図形〇の挿入、大きさの編集を自動化することができます。いくつもの図形を操作しなければならない場合手間と時間がかかりますが、VBAを使えば一瞬で処理することができます。

図形を挿入するVBA

図形を挿入するVBAはAddShapeメソッドを利用します。

AddShapeメソッド基本構造

Shapesオブジェクト . AddShape ( Type , Left , Top , Width , Height )

Type ・・・図形の種類
Left ・・・挿入位置
Top ・・・挿入位置
Width ・・・図形の大きさ
Height・・・図形の大きさ

Typeを変えれば〇以外にもいろんな図形を編集することができます。図形を挿入する業務が多い方は是非いろいろ試してみてください。

サンプル事例①指定した文字を○で囲むVBA

リストにある「文字」と一致する「文字」を○で囲みます。「文字」の長さによって○の大きさを変更する設定になっています。

このVBAはいろんなエクセル業務に応用することができます。「サンプル事例②工事注文書の作成」では実際の業務に図形〇をつけるVBAが使われています。

VBAの導入方法

1.標準モジュールにVBAを記入

2.文字を〇で囲むサンプルVBA

Sub 〇で囲む()
    Dim Ash As Worksheet
    Dim Bsh As Worksheet
    Set Ash = ThisWorkbook.Worksheets("設定")
    Set Bsh = ThisWorkbook.Worksheets("図形挿入")
    Dim zukeiA As Shape
    For Each zukeiA In Bsh.Shapes
    On Error Resume Next
    If zukeiA.TopLeftCell.Address >= Bsh.Cells(1, 1).Address Then
    zukeiA.Delete
    End If
    If Err <> 0 Then
    Err.Clear
    End If
    Next
    Dim ARange As Range
    Dim keyWord As String
    Dim zukeiH As Range
    gyoa = Ash.Cells(Rows.Count, 2).End(xlUp).Row
    For i = 4 To gyoa
    keyWord = Ash.Cells(i, 2)
    For j = 1 To 10
    For k = 1 To 10
    Set ARange = Bsh.Range(Bsh.Cells(j, k), Bsh.Cells(j, k))
    Set zukeiH = ARange.Find(keyWord, LookAt:=xlWhole)
    On Error Resume Next
    If zukeiH = keyWord And Len(keyWord) = 1 Then
        With Bsh.Shapes.AddShape(msoShapeOval, zukeiH.Left, zukeiH.Top, 15, 15)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
        End With
    ElseIf zukeiH = keyWord And Len(keyWord) = 2 Then
        With Bsh.Shapes.AddShape(msoShapeOval, zukeiH.Left, zukeiH.Top, 30, 15)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
        End With
    ElseIf zukeiH = keyWord And Len(keyWord) = 3 Then
        With Bsh.Shapes.AddShape(msoShapeOval, zukeiH.Left, zukeiH.Top, 40, 15)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
        End With
    ElseIf zukeiH = keyWord And Len(keyWord) = 4 Then
        With Bsh.Shapes.AddShape(msoShapeOval, zukeiH.Left, zukeiH.Top, 50, 15)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
        End With
    ElseIf zukeiH = keyWord And Len(keyWord) = 5 Then
        With Bsh.Shapes.AddShape(msoShapeOval, zukeiH.Left, zukeiH.Top, 60, 15)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
        End With
    Else
    End If
    If Err <> 0 Then
    Err.Clear
    End If
    Next
    Next
    Next
End Sub

3.「設定」シートにリストを作成

4.「画像挿入」シートに文字を記入

これで準備完了です。あとはVBAを実行するだけでリストにある文字と一致する文字を〇で囲むことができます。

サンプル事例②工事注文書の作成

工事注文書を作成するエクセルファイルに「文字に○をつけるVBA」を設定しました。

「一覧表」シートの内容から「注文書」シートの適切な場所に図形○を挿入、直線を引く、というものです。

VBAを導入することで、図形の編集にかかる手間と時間を削減することができました。決められた様式に図形を挿入する作業におすすめのVBAです。

このエクセルには、別シートにテキストを転記するVBAが設定されていて、下記のサイトで導入の方法やサンプル事例について詳しく解説されています。
実務で使用頻度の高いVBAなので自由に扱えるようにしておきましょう。

<<別シートに情報を自動反映させるマクロについて

VBAの導入方法

1.標準モジュールにVBAを記入

2.工事注文書サンプルVBA

Sub 工事注文書()
   ''''''''''''''''''''''''''Sheetの設定''''''''''''''''''''''''''
    Dim Ash As Worksheet
    Dim Bsh As Worksheet
    Set Ash = ThisWorkbook.Worksheets("一覧表")
    Set Bsh = ThisWorkbook.Worksheets("工事注文書")
    ''''''''''''''''''''''''''ユーザーフォームで入力した値を変数iで取得''''''''''''''''''''''''''
    i = UserForm1.TextBox1.Value
    ''''''''''''''''''''''''''Sheet内の図形を削除''''''''''''''''''''''''''
    '前回表示させた図形をリセットさせなければ重なって増え続けてしまう'
    Dim zukei As Shape
    For Each zukei In Bsh.Shapes
    On Error Resume Next
    If zukei.TopLeftCell.Address >= Bsh.Cells(1, 1).Address Then
    zukei.Delete
    End If
    If Err <> 0 Then
    Err.Clear
    End If
    Next
    ''''''''''''''''''''''''''一覧表から工事契約書へ値を転記する''''''''''''''''''''''''''
    '''''工事名を転記'''''
    Bsh.Range("H6") = Ash.Cells(i + 2, 2)
    Bsh.Range("H6").HorizontalAlignment = xlLeft
    '''''工事場所を転記'''''
    Bsh.Range("H8") = Ash.Cells(i + 2, 3)
    Bsh.Range("H8").HorizontalAlignment = xlLeft
    '''''工期(着手)を転記'''''
    Bsh.Range("H10") = Ash.Cells(i + 2, 4)
    Bsh.Range("H10").HorizontalAlignment = xlCenter
    Bsh.Range("H10").NumberFormatLocal = "ggge年m月d日"
    '''''工期(竣功)を転記'''''
    Bsh.Range("P10") = Ash.Cells(i + 2, 5)
    Bsh.Range("P10").HorizontalAlignment = xlCenter
    Bsh.Range("P10").NumberFormatLocal = "ggge年m月d日"
    '''''請負金額を転記'''''
    Bsh.Range("L12") = Ash.Cells(i + 2, 6)
    Bsh.Range("L12").HorizontalAlignment = xlCenter
    Bsh.Range("L12").NumberFormatLocal = "#,###"
    '''''消費税を転記'''''
    Bsh.Range("R14") = Bsh.Range("L12").Value * 0.1
    Bsh.Range("R14").HorizontalAlignment = xlCenter
    Bsh.Range("R14").NumberFormatLocal = "#,###"
    '''''支給材料の有無(図形○を表示)'''''
    If Ash.Cells(i + 2, 11) = "有" Then
        With Bsh.Shapes.AddShape(msoShapeOval, Range("Q20").Left + 25, Range("Q20").Top + 3, 14, 14)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
    End With
    ElseIf Ash.Cells(i + 2, 11) = "無" Then
         With Bsh.Shapes.AddShape(msoShapeOval, Range("Q20").Left + 57, Range("Q20").Top + 3, 14, 14)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
    End With
    Else
    End If
    '''''貸与品の有無(図形○を表示)'''''
    If Ash.Cells(i + 2, 12) = "有" Then
        With Bsh.Shapes.AddShape(msoShapeOval, Range("Q21").Left + 25, Range("Q21").Top + 3, 14, 14)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
    End With
    ElseIf Ash.Cells(i + 2, 12) = "無" Then
         With Bsh.Shapes.AddShape(msoShapeOval, Range("Q21").Left + 57, Range("Q21").Top + 3, 14, 14)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
    End With
    Else
    End If
    '''''発生品の有無(図形○を表示)'''''
    If Ash.Cells(i + 2, 13) = "有" Then
        With Bsh.Shapes.AddShape(msoShapeOval, Range("Q22").Left + 25, Range("Q22").Top + 3, 14, 14)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
    End With
    ElseIf Ash.Cells(i + 2, 13) = "無" Then
         With Bsh.Shapes.AddShape(msoShapeOval, Range("Q22").Left + 57, Range("Q22").Top + 3, 14, 14)
        .Fill.Visible = msoFalse
        .Line.Weight = 1
        .Line.ForeColor.RGB = vbBlock
    End With
    Else
    End If
    '''''工事数量調書の有無(図形線を表示)'''''
     If Ash.Cells(i + 2, 14) = "有" Then
         With Bsh.Shapes.AddLine(Bsh.Range("I24").Left, Bsh.Range("I24").Top + 6, Bsh.Range("P24").Left, Bsh.Range("P24").Top + 6).Line
        .Weight = 1
        .ForeColor.RGB = vbBlock
        End With
        With Bsh.Shapes.AddLine(Bsh.Range("I24").Left, Bsh.Range("I24").Top + 12, Bsh.Range("P24").Left, Bsh.Range("P24").Top + 12).Line
        .Weight = 1
        .ForeColor.RGB = vbBlock
        End With
    Else
    End If
    '''''示方書等の有無(図形線を表示)'''''
     If Ash.Cells(i + 2, 15) = "有" Then
         With Bsh.Shapes.AddLine(Bsh.Range("I25").Left, Bsh.Range("I25").Top + 6, Bsh.Range("P25").Left, Bsh.Range("P25").Top + 6).Line
        .Weight = 1
        .ForeColor.RGB = vbBlock
        End With
        With Bsh.Shapes.AddLine(Bsh.Range("I25").Left, Bsh.Range("I25").Top + 12, Bsh.Range("P25").Left, Bsh.Range("P25").Top + 12).Line
        .Weight = 1
        .ForeColor.RGB = vbBlock
        End With
    Else
    End If
    '''''工事数量調書の有無(図形線を表示)'''''
     If Ash.Cells(i + 2, 16) = "有" Then
         With Bsh.Shapes.AddLine(Bsh.Range("I26").Left, Bsh.Range("I26").Top + 6, Bsh.Range("P26").Left, Bsh.Range("P26").Top + 6).Line
        .Weight = 1
        .ForeColor.RGB = vbBlock
        End With
        With Bsh.Shapes.AddLine(Bsh.Range("I26").Left, Bsh.Range("I26").Top + 12, Bsh.Range("P26").Left, Bsh.Range("P26").Top + 12).Line
        .Weight = 1
        .ForeColor.RGB = vbBlock
        End With
    Else
    End If
    '''''発注者住所を転記'''''
    Bsh.Range("J33") = Ash.Cells(i + 2, 8)
    Bsh.Range("J33").HorizontalAlignment = xlLeft
    '''''発注者氏名を転記'''''
    Bsh.Range("J35") = Ash.Cells(i + 2, 7)
    Bsh.Range("J35").IndentLevel = 2
    '''''受注者住所を転記'''''
    Bsh.Range("J37") = Ash.Cells(i + 2, 10)
    Bsh.Range("J37").HorizontalAlignment = xlLeft
    '''''受注者氏名を転記'''''
    Bsh.Range("J39") = Ash.Cells(i + 2, 9)
    Bsh.Range("J39").IndentLevel = 2
End Sub

3.「設定」シートの様式を作る

必要な項目は業務内容によって違ってきます。書類作成に必要な項目をリストアップしておきましょう。

4.「工事注文書」シートの様式を作る

「設定」シートから転記する項目や場所を決めます。後々修正が発生しないようしっかりと考えて作り込んでおきましょう。

5.ユーザーフォームの設定

これでVBAの導入は完了です。

ユーザーフォームのテキストボックスに工事番号を入力しVBAを実行すると、テキストや図形が入力されます。

決められた様式のエクセルを編集するときに役立つVBAです。

文字に○をつけるVBAが設定されたエクセルファイルのダウンロード

この記事で紹介している、「文字を○で囲むVBAが設定されたエクセルファイル」と「工事注文書の作成エクセルファイル」の２つをダウンロードすることができます。

図形を操作する業務が多いという方は是非参考にしてみてください。

ここから先は

205字 / 2ファイル

¥ 500

ログイン

この記事が気に入ったらサポートをしてみませんか？