セルの値をワードアートに

質問

セルの値をワードアートに

A1に入力した値をワードアートに反映させていますが、
A1の値を複数のワードアートに反映させる場合は下記のコードの
3行目を数分だけ入れないとダメでしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)
　If Target.Address <> "$A$1" Then Exit Sub
　ActiveSheet.Shapes("WordArt 1").TextEffect.Text = Target.Value
End Sub

コピーしてワードアートオブジェクトの名前を一緒にしても
最初の1個しか反映されませんでした。

よろしくお願いします

回答No.1

MackyNo1 · ベストアンサー

同じ文字をすべてのワードアートのテキストに入力するなら以下のようなコードになります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 1 To ActiveSheet.Shapes.Count
If Target.Address <> "$A$1" Then Exit Sub
ActiveSheet.Shapes(i).TextEffect.Text = Target.Value
Next i
End Sub

お礼

回答ありがとうございます。

ワードアートのテキストは複数あり、
Ａ１のセルの値はワードアート１～３、
Ａ２のセルはワードアート４～８に反映さる感じです。

同じ文字を全てのテキストにする場合もありますので
大変参考になりました

ありがとうございます。

回答No.5

MackyNo1

＞ワードアートのテキストは複数あり、
Ａ１のセルの値はワードアート１～３、
Ａ２のセルはワードアート４～８に反映さる感じです。

ワードアートに反映させる個数に全く規則性のない場合は、当然のことですが、それぞれのケースに対応するコードを記載するしかありません（そもそもイベントマクロを実行する必要性(目的）がわかりませんが、 For i = 1 To 3のように、それぞれのインデックス番号の数字でわけるとわかりよいかもしれません）。

ちなみに規則性がある場合、例えばA1セルから下のセルを3つずつ順次参照するなら、以下のようなコードに変更すれば実行可能です。

ActiveSheet.Shapes(i).TextEffect.Text = Range("a1").Offset(Int((i - 1) / 3), 0).Value

お礼

回答ありがとうございます。
反映させる個数などの規則性はあったりなかったりで微妙な所です。

イベントマクロを実行する必要性（目的）はといいますと、
エクセル２０００の場合でワードアートにセル値を飛ばすのを
調べたらその方法しか発見出来ませんでしたので・・・

いろいろ難しそうですね。
まだまだVBAは分からない事だらけなので、
皆さんの意見を参考に勉強しなおしてみます。

有難うございました。

回答No.4

imogasi

#2,#3です。
すみません。＃３でFor　Eachで無いと出来ないような書き方をしましたが
Sub test02()
Worksheets("Sheet1").Shapes.Range(Array("WordArt 1", "WordArt 2", "WordArt 3")).Select
Selection.ShapeRange.TextEffect.Text = "長野市"
End Sub
で、
Selection.ShapeRange.TextEffect.Text = "長野市"
の１行で出きるようです。ShapeRangeが抜けていました。訂正します。

回答No.3

imogasi

#2です。
＞ワードアート自体が複数あり、Ａ１のセルに反映してる物が２個、
セルＡ２に反映している物が３個という具合にしたいと思
If Target.Address <> "$A$1" Then
　ActiveSheet.Shapes("WordArt 1").TextEffect.Text = Target.Value
ActiveSheet.Shapes("WordArt 2").TextEffect.Text = Target.Value
Exit　Sub
Else
If Target.Address <> "$A$2" Then
　ActiveSheet.Shapes("WordArt 3").TextEffect.Text = Target.Value
ActiveSheet.Shapes("WordArt 4").TextEffect.Text = Target.Value
ActiveSheet.Shapes("WordArt 5").TextEffect.Text = Target.Value
Exit　Sub
end If
のような面倒なコードになると思う。
自分で作業をやっているなら、こういうのは手動でセットしたほうが速いのではないかな。
ーー
ただし、下記のような書き方は出来るようだ
Sub test01()
Worksheets("Sheet1").Shapes.Range(Array("WordArt 1", "WordArt 2", "WordArt 3")).Select
'Selection.TextEffect.Text = "三鷹市" 'この書き方はエラー
For Each sh In Selection
MsgBox sh.Name
Selection.ShapeRange.TextEffect.Text = Worksheets("Sheet1").Range("A5").Value
Next
End Sub
Arrayの書き方、.ShapeRangeに注意。

お礼

回答ありがとうございます。

＞のような面倒なコードになると思う。
＞自分で作業をやっているなら、こういうのは手動でセットしたほうが速いのではないかな

シートの広い範囲に配置されているワードアートはおよそ７０個で、
それを毎回文字なり数字なりを微妙に変えないといけないため、
手動セットは時間がかかるのでコードでと思っています。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$4" Then
ActiveSheet.Shapes("start_k1").TextEffect.Text = Target.Value
Exit Sub
Else
If Target.Address <> "$D$5" Then
ActiveSheet.Shapes("dc_np1").TextEffect.Text = Target.Value
Exit Sub
End If
End Sub

回答を参考に上記で試してみましたがエラーでした。
2000だと難しいのでしょうか？

回答No.2

imogasi

図形の調整の隣の矢印キーで、２つのワードアート図形を捉えても、数式バー部にクリックを入れることが出来ーー
ワードアート図形をコピーしてはどうですか。
図形１つづつ個別に入れた後では変更されるかも。
ーー
VBAのコード上は、ワードアート以外の図形がない場合なら
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
For Each sp In Worksheets("Sheet1").Shapes
sp.TextEffect.Text = Target.Value
Next
End Sub
で一斉に変えられるが、こういうのはどうですか。
Shapes以外にオブジェクトがある場合は、Typeを判別するIf文を入れてワードアートに適用を限定するとか。

お礼

回答ありがとうございます

ワードアート以外の図形はないのですが、
ワードアート自体が複数あり、Ａ１のセルに反映してる物が２個、
セルＡ２に反映している物が３個という具合にしたいと思っています。

その場合でもＩＦ文を入れてという感じになるのでしょうか？