[[20200215221840]]　『矢印に数字を入れたい』（マクロ超初心者）　ページの最後に飛ぶ

『矢印に数字を入れたい』（マクロ超初心者）

　マクロ実行すると、インプットボックスが表示されます。
セル範囲を選択するとインプットボックスに書込まれます。
「OK」ボタンを押すことで矢印が描画されます。
矢印の中央の線辺りに数字を入れたいです。
可能であればインプットボックス等が出て数字が選択出来る様にしたいです。

 Sub 列矢印()
 Dim R As Range

 Set R = Application.InputBox("選択したセル範囲に矢印を描画します",   Type:=8)

 With ActiveSheet.Shapes.AddLine(R.Left + R.Width / 2, R.Top, R.Left + R.Width / 2, R.Top + R.Height).Line
 .ForeColor.RGB = RGB(0, 0, 255)
 .Style = 1
 .BeginArrowheadStyle = 3
 .EndArrowheadStyle = 3
 .Weight = 5
 End With
 End Sub

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

 >矢印の中央の線辺りに数字を入れたいです。

直線コネクタはテキストの編集ができないので図形のブロック矢印を使います。

Sub 列矢印2()

    Dim R As Range, n As Long

    n = Application.InputBox("矢印に記載する数字を入力してください。", Type:=1)
    Set R = Application.InputBox("選択したセル範囲に矢印を描画します", Type:=8)
    With ActiveSheet.Shapes.AddShape(msoShapeUpDownArrow, R.Left + (R.Width - 30) / 2, R.Top, 30, R.Height)
        .TextFrame.Characters.Text = n
        .TextFrame.Characters.Font.Size = 16
        '図形内テキストのフォントカラーを指定する
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
        '図形内のテキスト水平方向を中央位置にする
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        '図形内のテキスト縦方向を中央位置にする
        .TextFrame.VerticalAlignment = xlVAlignCenter
        '図形の枠線の色を指定する
        .Line.ForeColor.RGB = RGB(0, 0, 255)
        '図形の塗りつぶし色を指定する
        .Fill.ForeColor.RGB = RGB(0, 0, 255)
    End With
End Sub
（ピンク） 2020/02/15(土) 23:38

 >矢印の中央の線辺りに数字を入れたいです。 
それとも、こんな事？
Sub 列矢印3()
    Dim R As Range, n As Long
    n = Application.InputBox("矢印に記載する数字を入力してください。", Type:=1)
    Set R = Application.InputBox("選択したセル範囲に矢印を描画します", Type:=8)
    With ActiveSheet.Shapes.AddLine(R.Left + R.Width / 2, R.Top, R.Left + R.Width / 2, R.Top + R.Height).Line
        .ForeColor.RGB = RGB(0, 0, 255)
        .Style = 1
        .BeginArrowheadStyle = 3
        .EndArrowheadStyle = 3
        .Weight = 5
    End With
    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, R.Left + (R.Width / 2) + 10, R.Top + (R.Height / 2) - 10, 20, 20)
        '塗りつぶしなし
        .Fill.Visible = msoFalse
        '線なし
'        .Line.Visible = msoFalse
        .TextFrame.Characters.Text = n
        .TextFrame.Characters.Font.Color = RGB(0, 0, 255)
        .TextFrame.Characters.Font.Size = 11
        'テキストに合わせて図形のサイズを調整する
        .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    End With
End Sub

（ピンク） 2020/02/16(日) 00:16

ピンク様

思っていた通りの事が出来ました。ありがとうございます。
列矢印2も列矢印3どちらも求めていたことです。素晴らしいです。
申し訳ございませんが列矢印2バージョンの基本図形の右大かっこが出来れば最高です。
宜しくお願いします。
（マクロ超初心者） 2020/02/16(日) 00:51

 >基本図形の右大かっこが出来れば最高です。

AddShape(Type、 Left、 Top、 Width、 Height)
マクロの記録を行うとTypeが得られますので挑んでみられては
（ピンク） 2020/02/16(日) 09:22

ピンク様

アドバイスありがとうございました。

出来ました(^_-)-☆

もう一つ教えていただきたいのですが数字で○で囲んである数字を使いたい場合は
下記の記述をどうしたらいいでしょうか？宜しくお願いします。

n = Application.InputBox("矢印に記載する数字を入力してください。", Type:=1)

（マクロ超初心者） 2020/02/16(日) 10:13

 >数字で○で囲んである数字を使いたい場合は

1～20までの数字で良ければ
.TextFrame.Characters.Text = Chr(-30913 + n)

（ピンク） 2020/02/16(日) 10:41

ピンク様

再度アドバイスありがとうございました。

出来ました(^_-)-☆

（マクロ超初心者） 2020/02/16(日) 13:46

  Sub 列矢印2()

　With ActiveSheet.Shapes.AddShape(msoShapeUpDownArrow, R.Left + (R.Width - 30) / 2, R.Top, 30, R.Height)

                        ↓
  With ActiveSheet.Shapes.AddShape(msoShapeUpDownArrow, R.Left +  (R.Width - 30) / 2, R.Top, 30, R.Height-10)
 下向きの矢印を選択したセル範囲の少し内側にするにはR.Heightにマイナス を入れたら出来るのは分かりましたが上向きの矢印を選択したセル範囲の少し 内側にするには何処を調整したらいいでしょうか？
 教えていただきたい。

（マクロ超初心者） 2020/02/20(木) 23:48

Topを10足して、Heightを20引く
もう少し大きくは
Topを5足して、Heightを10引く

With ActiveSheet.Shapes.AddShape(msoShapeUpDownArrow, R.Left + (R.Width - 30) / 2, R.Top + 10, 30, R.Height - 20)

（ピンク） 2020/02/20(木) 23:59

ピンク様

ありがとうございました。

出来ました(^_-)-☆

（マクロ超初心者） 2020/02/21(金) 00:34

図形内のテキスト縦方向を下揃えにする
.TextFrame.Vertical Alignment = xIVAlignBottom

図形内のテキスト縦方向を中央位置にする
.TextFrame.Vertical Alignment = xIVA lignCenter

テキストを下揃えと中央位置へ選択出来る様に対話式のマクロにしたいのですが
どうしたらいいのでしょうか？
後出しで大変申し訳ございません。
（マクロ超初心者） 2020/02/21(金) 12:27

 >テキストを下揃えと中央位置へ選択出来る様に対話式のマクロにしたいのですが

Sub 列矢印4()

    Dim R As Range, n As Long, ret As Long

    n = Application.InputBox("矢印に記載する数字を入力してください。", Type:=1)
    ret = MsgBox("文字は下揃えにしまいか", vbYesNo + vbQuestion)
    Set R = Application.InputBox("選択したセル範囲に矢印を描画します", Type:=8)
    With ActiveSheet.Shapes.AddShape(msoShapeUpDownArrow, R.Left + (R.Width - 30) / 2, R.Top + 10, 30, R.Height - 20)
        .TextFrame.Characters.Text = n
        .TextFrame.Characters.Font.Size = 16
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = IIf(ret = 6, xlBottom, xlCenter)
        .Line.ForeColor.RGB = RGB(0, 0, 255)
        .Fill.ForeColor.RGB = RGB(0, 0, 255)
    End With
End Sub

（ピンク） 2020/02/21(金) 13:09

文字位置の指定でボタンを押さずに[Enter]を押すと
２番目のボタン[いいえ]で処理されます。vbDefaultButton2

Sub 列矢印5()

    Dim R As Range, n As Long, ret As Long

    n = Application.InputBox("矢印に記載する数字を入力してください。", Type:=1)
    ret = MsgBox("文字の縦位置を指定してください。" & vbCrLf & vbCrLf & _
                "上揃え" & vbTab & "： [はい]" & vbCrLf & _
                "中央揃え" & vbTab & "： [いいえ]" & vbCrLf & _
                "下揃え" & vbTab & "： [キャンセル]", _
                vbYesNoCancel + vbQuestion + vbDefaultButton2)
    Select Case ret
        '[はい]なら上揃え
        Case vbYes: ret = xlTop
        '[いいえ]なら中央揃え
        Case vbNo: ret = xlCenter
        '[キャンセル]なら下揃え
        Case vbCancel: ret = xlBottom
    End Select
    Set R = Application.InputBox("選択したセル範囲に矢印を描画します", Type:=8)
    With ActiveSheet.Shapes.AddShape(msoShapeUpDownArrow, R.Left + (R.Width - 30) / 2, R.Top + 10, 30, R.Height - 20)
        .TextFrame.Characters.Text = n
        .TextFrame.Characters.Font.Size = 16
        .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
        .TextFrame.HorizontalAlignment = xlHAlignCenter
        .TextFrame.VerticalAlignment = ret
        .Line.ForeColor.RGB = RGB(0, 0, 255)
        .Fill.ForeColor.RGB = RGB(0, 0, 255)
    End With
End Sub

（ピンク） 2020/02/21(金) 13:39

ピンク様
ありがとうございました。

（マクロ超初心者） 2020/02/21(金) 22:04

コメント返信：

[ 一覧(最新更新順) ]

[[20200215221840]] 『矢印に数字を入れたい』（マクロ超初心者） ページの最後に飛ぶ

[[20200215221840]]　『矢印に数字を入れたい』（マクロ超初心者）　ページの最後に飛ぶ