Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5503 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【50404】図形をセル内の指定位置へ移動したい 岳 07/7/23(月) 23:42 質問[未読]
【50406】Re:図形をセル内の指定位置へ移動したい Ned 07/7/24(火) 1:57 発言[未読]
【50410】Re:図形をセル内の指定位置へ移動したい 岳 07/7/24(火) 6:13 お礼[未読]
【50411】Re:図形をセル内の指定位置へ移動したい 岳 07/7/24(火) 7:14 質問[未読]
【50412】Re:図形をセル内の指定位置へ移動したい Ned 07/7/24(火) 11:23 発言[未読]
【50419】Re:図形をセル内の指定位置へ移動したい 岳 07/7/24(火) 19:28 発言[未読]
【50420】Re:図形をセル内の指定位置へ移動したい 岳 07/7/24(火) 19:45 お礼[未読]
【50425】Re:図形をセル内の指定位置へ移動したい Ned 07/7/24(火) 20:46 発言[未読]
【50430】Re:図形をセル内の指定位置へ移動したい 岳 07/7/24(火) 21:55 お礼[未読]
【50413】Re:図形をセル内の指定位置へ移動したい 駿 07/7/24(火) 12:23 回答[未読]
【50414】Re:図形をセル内の指定位置へ移動したい 駿 07/7/24(火) 12:25 回答[未読]
【50422】Re:図形をセル内の指定位置へ移動したい 岳 07/7/24(火) 20:10 お礼[未読]
【50404】図形をセル内の指定位置へ移動したい
質問  岳  - 07/7/23(月) 23:42 -
引用なし
パスワード
   初心者ですが、本を基本に、ここの質問箱で勉強させて頂いています。
今回、初めて図形に関わるマクロに挑戦したんですが基本的なことが分かりません。
持って要る本にはＳｈａｐｅに関することがほとんど書かれていないので、宜しくお願いします。

【質問】
Range("C10:C15)の位置にオートシェイプで赤丸を書いた。
この図形（赤丸）を各セルの上下方向の中間、左端から一定距離の位置に表示するには、どうすればいいのかを教えていただきたい。


【これまでに検討したこと】
［１］マクロを記録し、動きを確認しました。
For i = 1 To 6
　　ActiveSheet.Shapes("Picture " & i).Select
　　Selection.ShapeRange.IncrementLeft 2.25
　　Selection.ShapeRange.IncrementTop 7.5
Next
理解したこと・・・・現在の位置を基準に右、下（マイナス数値にすれば左、上）へ移動する

［２］ネット検索でのコードをヒントに表示位置を確認
For i = 1 To 6
　　ActiveSheet.Shapes("Picture " & i).Select
　　Selection.ShapeRange.Left = 100
　　Selection.ShapeRange.Top = 50 * i
Next
理解したこと・・・・Ａ列の左端を基準に右へ移動、1行目の上端を基準に下へ移動

調べた範囲内では、図形の表示位置はセル位置との相関性はとれないのかな？
と考えてしまいましたが、初心者のためよく分かりません。
図形を、表示したセル内の指定場所に移動させる方法を教えて下さい。

きっかけとなったのは図形をドラッグして移動してたら、位置がバラバラになってしまったからです。
実際に使用するシートのデーター範囲は列方向にはスクロールする必要ない範囲なので
ShapeRange.Left = 0　に初期化してから　ShapeRange.Left = 100 などを設定し、目視で確認すれば可能ですが
行数が5000〜10000行あり、行の高さも一様でないため、ShapeRange.top　では設定無理と判断し、投稿させて頂きました。
宜しくお願いします。
【50406】Re:図形をセル内の指定位置へ移動したい
発言  Ned  - 07/7/24(火) 1:57 -
引用なし
パスワード
   ▼岳 さん：
こんにちは。
>この図形（赤丸）を各セルの上下方向の中間、左端から一定距離の位置に表示するには
ActiveSheet.Shapes(1).Left = Range("E20").Left + 10
ActiveSheet.Shapes(1).Top _
　　= Range("E20").Top + (Range("E20").Height - ActiveSheet.Shapes(1).Height) / 2
こんな感じです。

WithステートメントとRange型変数を使って書くと以下。
Sub sample()
　　Dim r As Range
　　
　　Set r = Range("E20")
　　With ActiveSheet.Shapes(1)
　　　　.Left = r.Left + 10
　　　　.Top = r.Top + (r.Height - .Height) / 2
　　End With
　　Set r = Nothing
End Sub
【50410】Re:図形をセル内の指定位置へ移動したい
お礼  岳  - 07/7/24(火) 6:13 -
引用なし
パスワード
   ▼Ned さん：

回答ありがとうございました。
１時には寝てしまったので、お礼が遅くなりましたが、うまく出来ました。
またひとつ勉強になりました。
【50411】Re:図形をセル内の指定位置へ移動したい
質問  岳  - 07/7/24(火) 7:14 -
引用なし
パスワード
   ▼Ned さん：
すいません。追加質問させてください。
単独セルでの確認はうまくいきましたが、複数セルへの設定方法が分かりません。

>WithステートメントとRange型変数を使って書くと以下。
>Sub sample()
>　　Dim r As Range
>　　
>　　Set r = Range("E20")
　　 Set r = Range("E20:E24") とした場合

>　　With ActiveSheet.Shapes(1)
　　ここをどう書き換えればいいか分かりません。

　　Shapesに関する宣言文も必要なのでしょうか？

　　初歩的なことも分からず申し訳ありませんが、宜しくお願いします。
【50412】Re:図形をセル内の指定位置へ移動したい
発言  Ned  - 07/7/24(火) 11:23 -
引用なし
パスワード
   ▼岳 さん：
まずは、For Each...Next ステートメントなどの基本構文は理解されてますか？

Sub sample2()
　　Dim r As Range
　　
　　For Each r In Range("E20:E24")
　　　　Debug.Print r.Top, r.Height, r.Left
　　Next r
End Sub

Sub sample3()
　　Dim i As Long
　　
　　For i = 1 To 5
　　　　With Cells(i + 19, 5)
　　　　　　Debug.Print .Top, .Height, .Left
　　　　End With
　　Next i
End Sub

このLoop処理内で、既存のShapeを移動させるか、新たに追加するか。
既存のShapeを移動させる場合は、そのShapeの指定をどうするか。
インデックス（順番）で指定するのか、名前＋数値の変数で指定するのか。

Sub sample4()
　　Dim s As Shape
　　
　　For Each s In ActiveSheet.Shapes
　　　　Debug.Print s.Name, s.Top, s.Height, s.Left
　　Next s
End Sub


または、既に大まかに配置したShepeの微調整なら、セル範囲を指定せずに、
ShepeのTopLeftCell プロパティでShape自身の左上セルを取得して
そのセルの位置情報を元にShapeの位置を微調整する方法もあります。
【50413】Re:図形をセル内の指定位置へ移動したい
回答  駿  - 07/7/24(火) 12:23 -
引用なし
パスワード
   ▼岳 さん：
岳さんのレスは数回読ましていただきました。感心してよみました。
私も初心者ですが、思い切ってレスします。

>単独セルでの確認はうまくいきましたが、複数セルへの設定方法が分かりません。
で、複数セルを選択する必要が無いように思います。移動させたいのは、("E20:E24")範囲の中心ですよね。

>>　　With ActiveSheet.Shapes(1)
は、（）内を　i　に代えて　For〜　で動きました。名前に関係なく作成した作った順番で選択していくみたいです。
With ActiveSheet.Shapes("Picture " & i)
でも出来ました。

参考になるかどうかは別で、『岳さんに負けないように私もがんばります』と思っている私のような人間がいるってことで読んで下さい。
なんか文章が下手ですみません。
【50414】Re:図形をセル内の指定位置へ移動したい
回答  駿  - 07/7/24(火) 12:25 -
引用なし
パスワード
   レス書いてるうちにNedさんから回答ありましたね。私のは無視してかまいません。
【50419】Re:図形をセル内の指定位置へ移動したい
発言  岳  - 07/7/24(火) 19:28 -
引用なし
パスワード
   ▼Ned さん：
返事が遅くなって申し訳ありませんでした。
あれこれトライしている内に時間がたってしまいました。
まだ、解決に至っていませんが途中経過を報告します。

>まずは、For Each...Next ステートメントなどの基本構文は理解されてますか？

これまで一般的な表計算、検索、別シートに結果を記入や、入門書によく記載されている空白行の削除、重複削除などをアンチョコを見ながらマクロを作って来ました。
但し、最初に書いたように図形に関しては今回が初めてです。
ループは　For〜Nextを多用してきましたが、本にFor　Each〜の方が処理速度が速いと書いていたので、少しづつ使うようにしています。
またWithステートメントを掲示板でよく見るので少しづつ勉強中です。

【検討したこと】
［１］Ｎｅｄさんの提示してくれたSample２〜４の理解する
・Sample２と３は同じことを意味している
・取得される値はＡ１セルの上左端を基点とした指定セルの座標
・Sample４は図形の位置をＡ１セルの上左端を基点とした座標を取得
　（違ってたらご教授願います）

［２］最初に教えて頂いたコードを指定範囲でループさせる

Sub 練習1()

　Dim r As Range
　Dim i As Integer
　　
　　For i = 1 To 5
　　With ActiveSheet.Shapes(i)
　　　　.Left = Cells(19 + i).Left + 10
　　　　.Top = Cells(19 + i).Top + (Cells(19 + i).Height - .Height) / 2
　　End With
　　Next
　　
End Sub

上記コードでやったら図形が消えてしまいました。
色々やっていたら、図形位置が変わらなかったり、部分的に消えたりで・・・・


>インデックス（順番）で指定するのか、名前＋数値の変数で指定するのか。
>
>>
>または、既に大まかに配置したShepeの微調整なら、セル範囲を指定せずに、
>ShepeのTopLeftCell プロパティでShape自身の左上セルを取得して
>そのセルの位置情報を元にShapeの位置を微調整する方法もあります。

このアドバイスから
図形が消えたり加えたりでインデックスが変更されているのでは思い、教えて頂いたTopLeftCellと共に調べて見ました。
その結果、下記コードでインデックスが適正でないことが分かり（こんなことも知りませんでした）、図形のセル位置の取得も出来ました。

Sub 練習2()

MsgBox Selection.Name
MsgBox Selection.TopLeftCell.Address

End Sub

【検討したこと２】
・処理を２回に分けて、図形１個づつを指定場所へ移動・・・・取りあえずうまくいきました
（１）　MsgBox Selection.Name　で図形のインデックスを取得
（２）　以下のコードに取得したインデックス番号を入力

Sub 練習3()
Dim r As Range
Dim myZuban As Integer

myZuban = Application.InputBox("図形の番号を入力")
　　
　　Set r = ActiveCell
　　With ActiveSheet.Shapes(myZuban)
　　　　.Left = r.Left + 10
　　　　.Top = r.Top + (r.Height - .Height) / 2
　　End With
　　Set r = Nothing
　　
End Sub

【検討したこと３】
・前記の（１）と（２）を一括で処理する
これまでの試行錯誤で、MsgBox Selection.Name　の結果は「Oval　３」と表示されていたのに
練習３では「３」だけを入力して正常稼動したので、数字だけをShapes（）の中に入れなければと思っていますが、現在やり方が分からない状況です。
やったことは下記の通しです。

Sub 練習4()
　
Dim r As Range
Dim myZuban As Integer

MsgBox Selection.Name　　　　’表示は　Oval　３
myZuban = Right(Name, 1)
MsgBox myZuban　　　　　　　　　’表示は　０
MsgBox Selection.TopLeftCell.Address　　　　　’図形のあるセル番地を表示

Set r = Selection.TopLeftCell
　　With ActiveSheet.Shapes(myZuban)　’ここでエラー（原因は０のため？）
　　　　.Left = r.Left + 10
　　　　.Top = r.Top + (r.Height - .Height) / 2
　　End With
　　Set r = Nothing

　End Sub

結局は
　　With ActiveSheet.Shapes(変数)
の書き方に戻ってしまいました。
【50420】Re:図形をセル内の指定位置へ移動したい
お礼  岳  - 07/7/24(火) 19:45 -
引用なし
パスワード
   ▼Nedさん：こんいちは
送った直後にミスに気づきました。
初期の目的達成しました。今後も宜しくお願いします。

>［２］最初に教えて頂いたコードを指定範囲でループさせる
>
>Sub 練習1()
>
>　Dim r As Range
>　Dim i As Integer
>　　
>　　For i = 1 To 5
>　　With ActiveSheet.Shapes(i)
>　　　　.Left = Cells(19 + i).Left + 10
>　　　　.Top = Cells(19 + i).Top + (Cells(19 + i).Height - .Height) / 2
>　　End With
>　　Next
>　　
>End Sub
>
>上記コードでやったら図形が消えてしまいました。

セルの列指定していませんでした。（アホみたい）
【50422】Re:図形をセル内の指定位置へ移動したい
お礼  岳  - 07/7/24(火) 20:10 -
引用なし
パスワード
   ▼駿 さん：
こんいちは、回答有難うございます。

色々やってたら駿さんからの回答に気づくのが遅くなりました。
申し訳ありません。


>>>　　With ActiveSheet.Shapes(1)
>は、（）内を　i　に代えて　For〜　で動きました。名前に関係なく作成した作った順番で選択していくみたいです。

私もこれを最初にやっったんですが、Cells（Row、Column）のColumnが抜けていたのにズ〜と気づきませんでした。「今まで何をやってきたんだ」と落ち込んじゃいました。

>
>参考になるかどうかは別で、『岳さんに負けないように私もがんばります』と思っている私のような人間がいるってことで読んで下さい。

過分なお言葉です。非常に嬉しかったです。私の回りにはマクロを知っている人がいないのでコツコツとやっています。峻さんのお言葉は励ましと取りました。
お互いに頑張りましょう。
ありがとうございます。

Nedさんへ
先ほどのお礼のレスに、余りのボンミスにお礼を言うのを忘れてしまいました。
ありがとうございました。
【50425】Re:図形をセル内の指定位置へ移動したい
発言  Ned  - 07/7/24(火) 20:46 -
引用なし
パスワード
   ▼岳 さん：
>初期の目的達成しました。
良かったですね^ ^

Sub 練習4()が今ひとつやりたい事がわからなかったのですが

Sub おまけ()
　　'"Oval x"のxが連番になっている場合。
　　Dim i As Long
　　
　　For i = 1 To 5
　　　　With ActiveSheet.Shapes("Oval " & i)
　　　　　　.Left = .TopLeftCell.Left + 10
　　　　　　.Top = .TopLeftCell.Top + (.TopLeftCell.Height - .Height) / 2
　　　　End With
　　Next i
End Sub
こんな事ですか？

また、Ovalの名前連番をつけ直したい時などは
Sub おまけ2()
　　Dim i As Long
　　
　　For i = 1 To ActiveSheet.Ovals.Count
　　　　ActiveSheet.Ovals(i).Name = "Oval " & i
　　Next i
End Sub
...などで。

ついでにShape位置の微調整だけなら名前やIndexを取らなくてもできるので
Sub おまけ3()
　　Dim s As Oval
　　
　　For Each s In ActiveSheet.Ovals
　　　　With s.TopLeftCell
　　　　　　s.Left = .Left + 10
　　　　　　s.Top = .Top + (.Height - s.Height) / 2
　　　　End With
　　Next s
End Sub
...など。

おまけ2と3で使った Oval は隠しオブジェクトです。
（以前のバージョンとの互換性を保持するためにあるものだそうです）
なので混乱するかもしれませんが、参考まで。
（ヘルプで確認しておいてください）
【50430】Re:図形をセル内の指定位置へ移動したい
お礼  岳  - 07/7/24(火) 21:55 -
引用なし
パスワード
   ▼Ned さん：
こんばんわ

懇切丁寧なアドバイス、有難うございました。

>Sub 練習4()が今ひとつやりたい事がわからなかったのですが

やろうとしていたことは　おまけ２（）の方法でした。
教えていただくと、「そうか！countなんだ」と思い出しましたが、試行錯誤している時には思いもつきませんでした。

おまけ３（）と解説も非常に参考になりました。

先ほどは、ボンミスに気づいて、あせって御礼のレスを送り
肝心のお礼の言葉を書くのを忘れてしまいました。申し訳ありません。

改めて、御礼を申し上げます。ありがとうございました。
この程度の者ですが、今後とも宜しくお願いいたします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
5503 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free