| |
▼こまったちゃん さん：
こんにちは。
>同一シート内に同一オートシェイプ名が複数有った場合、
>シートの１ページ目から該当のオートシェイプ名（例えばAS1)を指定し、
>名前を変更したいのですが、
>なぜか、最後のページのオートシェイプ名が変わります。
>直前に１ページ目のあるセルをセレクトしても駄目でした。
>
>なぜ同一シート内に同一オートシェイプ名が複数有るかというと、
>ある1ページ１シートをある個数分コピーして帳票を出すという処理を
>やりたいためです。
>セル指定だと、うまくレイアウトできないため、オートシェイプを使用しています。
上記の現象は、新規ブック（Sheet1とSheet2 というシート名が存在する）
の標準モジュールに以下のコード（main）を実行すると再現できます。
'========================================================
Sub main()
Dim g0 As Long
Dim shp As Shape
With Worksheets("sheet1")
.Select
Set shp = txt(.Range("a1"))
shp.Name = "shp1"
End With
With Worksheets("sheet2")
.Select
For g0 = 1 To 3
Worksheets("sheet1").Rows("1:10").Copy
.Rows("1:1").Insert Shift:=xlDown
Next
.Shapes("shp1").Select '行の下の図形が選択される
End With
End Sub
'========================================================
Function txt(ByVal rng As Range) As Shape
With rng
Set txt = .Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _
.Left, .Top, .Width, .Height)
End With
End Function
そもそも同一シートに同じ名前の図形が存在することは
バグだと思いますけどねえ!!
コピー時に図形の名前を一意に決まるものに変えるというのはいかがですか？
再度、新規ブック（Sheet1とSheet2 というシート名が存在する）
の標準モジュールに
'===================================================================
Sub main2()
Dim g0 As Long
Dim shp As Shape
With Worksheets("sheet1")
.Select
Set shp = txt(.Range("a1"))
shp.Name = "shp1"
End With
With Worksheets("sheet2")
.Select
For g0 = 1 To 3
Worksheets("sheet1").Rows("1:10").Copy
.Rows("1:1").Insert Shift:=xlDown
.Shapes("shp1").Name = "shp" & 3 - g0 + 1
Next
.Shapes("shp1").Select '行の上の図形が選択される
End With
End Sub
'=================================================================
Function txt(ByVal rng As Range) As Shape
With rng
Set txt = .Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _
.Left, .Top, .Width, .Height)
End With
End Function
として、main2を実行してみてください。
これで図形にユニークな名前が付けられました。
検討してみてください。
|
|
ichinose
- 07/2/17(土) 11:50 -
