Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6161 / 13644 ツリー ←次へ | 前へ→

【46828】同一シート内に同一オートシェイプ名が有った場合 こまったちゃん 07/2/16(金) 15:48 質問[未読]
【46832】Re:同一シート内に同一オートシェイプ名が... ichinose 07/2/17(土) 11:50 発言[未読]
【46857】Re:同一シート内に同一オートシェイプ名が... こまったちゃん 07/2/19(月) 10:07 お礼[未読]

【46828】同一シート内に同一オートシェイプ名が有...
質問  こまったちゃん  - 07/2/16(金) 15:48 -

引用なし
パスワード
   いつもお世話になっています。

同一シート内に同一オートシェイプ名が複数有った場合、
シートの1ページ目から該当のオートシェイプ名(例えばAS1)を指定し、
名前を変更したいのですが、
なぜか、最後のページのオートシェイプ名が変わります。
直前に1ページ目のあるセルをセレクトしても駄目でした。

なぜ同一シート内に同一オートシェイプ名が複数有るかというと、
ある1ページ1シートをある個数分コピーして帳票を出すという処理を
やりたいためです。
セル指定だと、うまくレイアウトできないため、オートシェイプを使用しています。

何か解決方法がありましたら教えて下さい。

【46832】Re:同一シート内に同一オートシェイプ名...
発言  ichinose  - 07/2/17(土) 11:50 -

引用なし
パスワード
   ▼こまったちゃん さん:
こんにちは。

>同一シート内に同一オートシェイプ名が複数有った場合、
>シートの1ページ目から該当のオートシェイプ名(例えばAS1)を指定し、
>名前を変更したいのですが、
>なぜか、最後のページのオートシェイプ名が変わります。
>直前に1ページ目のあるセルをセレクトしても駄目でした。
>
>なぜ同一シート内に同一オートシェイプ名が複数有るかというと、
>ある1ページ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を実行してみてください。

これで図形にユニークな名前が付けられました。

検討してみてください。

【46857】Re:同一シート内に同一オートシェイプ名...
お礼  こまったちゃん  - 07/2/19(月) 10:07 -

引用なし
パスワード
   ichinose さん

教えていただきありがとうございました!
検討した結果、1ページ1シートでそれぞれ作成して、
(そうすれば、オブジェクト名は重複しないため)
最後に1シートにすることにしました。

でもichinose さんのやり方も知ることが出来てよかったです。
どうもありがとうございました。

6161 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free