都道府県穴埋めゲーム

Sheets("Sheet1")に貼り付けたJ-pegの画像(=シンボルマーク)を別なシートに貼り付けるのは下記のVBAで出来ました。ただ、これでは貼り付け先のシートのセルK12が、貼り付け元のK12と同じ位置でないと思った場所に張り付きません。
そこでセルで場所を指定するのではなく、座標のようなもので指定する方法はないものかと考えた次第です。
オートシェイプなどは座標指定で作成できるのですが、J-pegのような画像はどうすればいいのでしょうか?

Sub TEST()
Sheets("FACE").Shapes("シンボルマーク").Copy
ActiveSheet.Range("K12").Select
ActiveSheet.Paste
End Sub

A 回答 (4件)

#1です。


>この場合、ファイルをエクセルにくっつけて渡すなんてこと
>はできないものでしょうか?(別々にではなくあくまでエク
>セルのブックに付属した形で)
Excelのブックに付属した形にするなら、コピーペーストする方がいいと思います。一旦挿入した画像を別途保存するのは、簡単には出来ないと思います。

複数のシートで同じような作業をするなら、次のような方法も考えられます。
Function CpyMrk(MrkNM As String, myTop As Single, myLeft As Single)
Sheets("FACE").Shapes(MrkNM).Copy
ActiveSheet.Paste
ActiveSheet.Shapes(MrkNM).Top = myTop
ActiveSheet.Shapes(MrkNM).Left = myLeft
End Function

Sub test()
CpyMrk "シンボルマーク", 10, 10
End Sub
    • good
    • 3
この回答へのお礼

何度もお手数をかけ、ありがとうございました。
とても勉強になりました。

お礼日時:2004/06/03 23:22

#1です。

お礼の中でのご質問の件ですが、
>それともオートシェープのように一行で座標指定する書き方
>もあるのでしょうか?
ペーストでは、直接座標を指定できないと思います。
AddPictureメソッドを使ったらどうでしょうか?
ActiveSheet.Shapes.AddPicture "フルパスファイル名" _
, msoFalse, msoTrue, 100, 200, 100, 100
    • good
    • 2
この回答へのお礼

AddPictureメソッドという手もあるんですね。
この場合、ファイルをエクセルにくっつけて渡すなんてことはできないものでしょうか?(別々にではなくあくまでエクセルのブックに付属した形で)

お礼日時:2004/05/31 16:50

>それともオートシェープのように一行で座標指定する書き方もあるのでしょうか?


ないと思います。
本題から少し離れ、関連して
(数値指定するとき)
もし垂直に5つ並べるなら、コピーでなく、いっそのことAddメソッドを繰り返して
Sub TEST01()
Dim myTop As Single, myLeft As Single
For i = 1 To 5
mleft = 100
mtop = (i - 1) * 100 + 50
ActiveSheet.Shapes.AddShape(msoShapeSun, mleft, mtop, 50#, 50#).Select
Next i
End Sub
水平に並べるならmleftを
mleft = (i - 1) * 100 + 50
mtop = 100
にしてはどうでしょう。
(カーソル位置指定)
1個1個指定しては、実行となりますが
#1のコードを実行すると、どうも
アクチブセルの置き所と貼りつけられたシェイプの位置は
相関関係がありそうですが、良く判りません。初めにコピーする時のアクチブセルの置き所とシェイプとの位置関係を引きずるようでもありますが、自信なし。
セルの位置と関連ずけるなら、
For i = 1 To 5
mleft = Cells(i, 1).Left
mtop = Cells(i, 1).Top
ActiveSheet.Shapes.AddShape(msoShapeSun, mleft, mtop, 50#, 50#).Select
Next i
なども可能です。
またTopLeftCellと言うプロパティがあるようですが、値の取得のみで、設定はさせてくれません。
ご参考までに。ご質問と
ピントがずれていた場合はご免。
    • good
    • 0
この回答へのお礼

ありがとうございました。
なあるほど・・・・・。

とても勉強になりました。

お礼日時:2004/05/31 16:47

COPY,PASTEでやるなら、一旦元の座業位置を保存し、ペースト後のshapeに適用するのが普通かと思います。



Sub TEST()
Dim myTop As Single, myLeft As Single
myTop = Sheets("FACE").Shapes("シンボルマーク").Top
myLeft = Sheets("FACE").Shapes("シンボルマーク").Left
Sheets("FACE").Shapes("シンボルマーク").Copy
ActiveSheet.Paste
ActiveSheet.Shapes("シンボルマーク").Top = myTop
ActiveSheet.Shapes("シンボルマーク").Left = myLeft
End Sub
    • good
    • 1
この回答へのお礼

さっそくありがとうございました。これならオリジナルと寸分違わない位置に配置できますね。勉強になりました。

ところで、オートシェープだと
ActiveSheet.Shapes.AddShape(msoShapeSun, 509.25, 47.25, 141#, 138#).Select
のように、直接、座標を入れられますが、Copyで持ってくるものは、この場合、myTopやmyLeftに代入するしか方法はないですか?
それともオートシェープのように一行で座標指定する書き方もあるのでしょうか?

お礼日時:2004/05/28 17:56

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


おすすめ情報

このQ&Aを見た人がよく見るQ&A