[[20180516110414]]　『テキストボックスVBAで複数作りたい』（みみん）　ページの最後に飛ぶ

『テキストボックスVBAで複数作りたい』（みみん）

お世話になります
ご教授いただけたら幸いです

自動記録でテキストボックスを作り
セル値反映は下記のようにできました
下記の内容で
A54からA83までのセル値のテキストボックス作りたいです
どのようにすればいいのでしょうか

お手数おかけしますが
何卒よろしくお願いいたします

Sub テキストボックス()
'
' テキストボックス Macro
'

    ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 741.75, 211.5, 72, 72 _
        ).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(3, 1).Text
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
End Sub

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

下記の行でエラーが出てしまいます
何がいけないのでしょうか

 Selection.ShapeRange(i).TextFrame2.TextRange.Characters.Text = Cells(ii, 1).Text

Sub テキストボックスループ()
Dim myCnt As Long, i As Long, ii As Long
ii = 54
i = 1

    For myCnt = 1 To 30
      ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 741.75, 211.5, 72, 72 _
        ).Select
    Selection.ShapeRange(i).TextFrame2.TextRange.Characters.Text = Cells(ii, 1).Text
    Selection.ShapeRange(i).TextFrame2.TextRange.Characters(1, 4).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
 ii = ii + 1
 i = i + 1

    Next myCnt

End Sub
（みみん） 2018/05/16(水) 11:20

エラーになるのは、1つのテキストボックスにShapeRangeは1つしかないから。そこを変えてはいけませんよ。 2つ目、3つ目…のテキストボックスの、ShapeRange(1)にセットしないと。それに、複数作るのに、全部同じ位置に出力してしまうと、重なっちゃいますよ？

とりあえず、元の文字列の隣に並べてみる例。

 Sub test()
    Dim i As Long

    For i = 54 To 83
        With ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
            ActiveSheet.Cells(i, "B").Left, _
            ActiveSheet.Cells(i, "B").Top - ActiveSheet.Cells(i, "B").Height / 2, _
            72, 72)
            .TextFrame2.TextRange.Characters.Text = ActiveSheet.Cells(i, "A").Text
            .TextFrame2.TextRange.Characters(1, 4).ParagraphFormat.FirstLineIndent = 0
            With .TextFrame2.TextRange.Characters(1, 4).Font
                .NameComplexScript = "+mn-cs"
                .NameFarEast = "+mn-ea"
                .Fill.Visible = msoTrue
                .Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
                .Fill.ForeColor.TintAndShade = 0
                .Fill.ForeColor.Brightness = 0
                .Fill.Transparency = 0
                .Fill.Solid
                .Size = 11
                .Name = "+mn-lt"
            End With
        End With
    Next i
 End Sub

（???） 2018/05/16(水) 11:39

???様

ありがとうございます
またわからなければ
質問させていただきます
（みみん） 2018/05/16(水) 14:38

コメント返信：

[ 一覧(最新更新順) ]

[[20180516110414]] 『テキストボックスVBAで複数作りたい』（みみん） ページの最後に飛ぶ

[[20180516110414]]　『テキストボックスVBAで複数作りたい』（みみん）　ページの最後に飛ぶ