[[20080926072706]]　『VBA:画像の挿入2』（masabou5）　ページの最後に飛ぶ

『VBA:画像の挿入2』（masabou5）

 お世話になります。

 sheet1上に画像pic1からpic5（と名前をつけてあります）があります。
 pic1～pic5のどれをかをクリックすると、セルA1に入り、
 次に他の画像をクリックすると、セルA10に入る。
 このようにA1→A10→B1→B10→C1･･･に順々に入るようにしたいのですが、
 どのようにすれば出来るでしょうか？

 よろしくご教授お願いします。

 >セルA1に入り、

 何が入るんですか?
 (tora)

 貼り付けた画像に下記マクロをマクロ登録。
 これ以降は自分でやってください。
 BJ

 Sub zuzu()
 Dim ClicShp As String, CZU_1 As Shape, CZU_2 As Shape
 Dim Cel As Range, HT1 As Range, HT2 As Range
 Dim Flg_1 As Boolean, Celset As Range

 ClicShp = Replace(Application.Caller, "図", "Picture")
 On Error Resume Next
 Set CZU_1 = ActiveSheet.Shapes(ClicShp)
 On Error GoTo 0
 If CZU_1 Is Nothing Then
   Exit Sub
 End If
 For Each Cel In Range("A1,A10,B1,B10,C1,C10")
    Flg_1 = False
    For Each CZU_2 In ActiveSheet.Shapes
        Set HT1 = Application.Intersect(Cel, CZU_2.TopLeftCell)
        Set HT2 = Application.Intersect(Cel, CZU_2.BottomRightCell.Offset(, -1))
        If Not HT1 Is Nothing Or Not HT2 Is Nothing Then
           Flg_1 = True
        End If
    Next
    If Flg_1 = False Then
       Set Celset = Cel
       Exit For
    End If
 Next
 If Flg_1 = False Then
    CZU_1.LockAspectRatio = msoFalse
    CZU_1.Top = Celset.Top
    CZU_1.Left = Celset.Left
    CZU_1.Height = Celset.Height
    CZU_1.Width = Celset.Width
 End If
 Set Celset = Nothing
 Set CZU_1 = Nothing
 Set HT1 = Nothing
 Set HT2 = Nothing
 End Sub

 toraさん、ありがとうございます｡
 分かりにくくて申し訳ありません。
 例えば、pic1クリックをクリックすると、pic1の画像がA1に入るようにしたいと言うことです。（masabou5）

 BJさん、ありがとうございます｡
 コードが少し難しいので、私なりに検討してみます。
 出来るだけ自力で出来るように頑張ります。（masabou5）

 BJさん、とても参考になり、私がやりたいことが実現できました。

 申し訳ありませんが、もう一つ教えていただけませんか？
 それは、上記Pic1～Pic5をクリックしたとき、
 元の画像（最初のPic1～Pic5の画像）はそのまま前の位置に置いておきたいのですが、どうすればよいでしょうか？
 いろいろ試してみましたが、どうしても出来ません。

 まことにお手数ですが、もう一回教えて下さい。
 よろしくお願いします｡（masabou5）

 BJさんのコードで

     CZU_1.LockAspectRatio = msoFalse　の上の行に

 以下のコードを挿入してみて試してみてください。
　
ActiveSheet.Shapes(ClicShp).Copy
Celset.Select
ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)"
myShp_name = Selection.ShapeRange.Name
Set CZU_1 = ActiveSheet.Shapes(myShp_name)

 （川野鮎太郎）

 川野鮎太郎さん、試してみました。
 全く問題なく動作しました。
 エクセルの学校の回答者の皆様の実力と、親切なご教授に対して頭が下がります。
 私の力では出来ないことを教えていただき、感謝の念で一杯です。

 BJさん、川野さん、ほんとにありがとうございました｡
 とても感激しました。
 心から御礼申し上げます。（masabou5）

 画像の挿入はうまくできましたが、もう一つ問題が出てきました。
 それは、Ａ1やA10に挿入された画像を、
 コントロールツールボックスのコマンドボタンを押すことにより、一括削除する方法が分からなくなりました。
 たびたびで申し訳ありませんが、ご教授よろしくお願いします｡(masabou5)

 こんなので事足りますか。
Sub Test鮎()
Dim myShape As Object
Dim myCol As Long, myRow As Long
For Each myShape In ActiveSheet.DrawingObjects
    With myShape.BottomRightCell
        myCol = .Column
        myRow = .Row
        If myCol <= 4 And myRow <= 11 Then
            myShape.Delete
        End If
    End With
Next myShape
End Sub

 （川野鮎太郎）

 川野さん、masabou5です。
 ああでもない、こうでもないと、いろいろいじり回していましたが、
 川野さんのご教授でバッチリ削除できました。
 このコードを大切に保存させていただき、今後の参考にさせていただきます。
 ほんとうにありがとうございました｡
 御礼申し上げます。（masabou5）

コメント返信：

[ 一覧(最新更新順) ]

[[20080926072706]] 『VBA:画像の挿入2』（masabou5） ページの最後に飛ぶ

[[20080926072706]]　『VBA:画像の挿入2』（masabou5）　ページの最後に飛ぶ