Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : その他)
写真画像を貼り付ける
投稿日時: 25/07/25 19:26:52
投稿者: KOJI2025

大変古いですが、
excel2003で「写真貼り付けのマクロ」を作りたいです。
ツールタブからマクロ実行ボタンを押し、
写真貼り付けはできました。
 
コマンドボタンにマクロを登録し、
コマンドボタンを押してからマクロを実行したいのですが、
コマンドボタン自体が画像として選択され、
写真画像と一緒にセルに貼り付けされてしまいます(笑)。
 
コマンドボタンを、画像として選択できないようにするVBA、
はありますか?回答をよろしくお願いいたします。

回答
投稿日時: 25/07/25 21:23:27
投稿者: simple

引用:
コマンドボタン自体が画像として選択され、
写真画像と一緒にセルに貼り付けされてしまいます(笑)。
笑っている場合ですが、それはどんなアクションをしたときに、ということですか?
シート全体を選択して別のシートにコピーペイストしたとき、ということですか?
 
ボタンの上で右クリックして、「コントロールの書式設定」を選択し、
さらに「プロパティ」タブをクリックすると、
オブジェクトの位置関係
・セルに合わせて移動やサイズ変更をする
・セルに合わせて移動するがサイズ変更はしない
・セルに合わせて移動やサイズ変更をしない
という3つの選択肢があると思います。
 
このうちの最後を選択すれば、ボタンはコピーされないはずです。
 
上記はExcel365での表示例ですが、これはかなり昔からあったはずです。
2003では既に備わっていたんじゃないかと思われます。確認して下さい。

投稿日時: 25/07/25 21:51:02
投稿者: KOJI2025

名前を間違えました。失礼しました。
コマンドボタンではなく、フォームボタンでした。
 
>>それはどんなアクションをしたときに、ということですか?
フォームボタンをクリックした時に、ボタンも移動しました。
 
>>セルに合わせて移動やサイズ変更をしない
この設定にしましたが、ボタンが移動しました。
 
コードを貼らせていただきます。
ネットのサンプルコードを一部修正したものです。
よろしくお願いいたします。
 
 
Sub 写真自動配置()
Dim targetRange As Range
Dim i As Variant
Dim abc As Long
 
abc = ActiveSheet.Shapes.Count
 
ActiveSheet.Pictures.Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.Width = 234
Selection.Height = 170
 
For i = 1 To abc
Set targetRange = Cells(i, 2)
ActiveSheet.Shapes(i).Select
Selection.ShapeRange.Left = targetRange.Left
Selection.ShapeRange.Top = targetRange.Top
Next i
 
End Sub

回答
投稿日時: 25/07/25 23:38:59
投稿者: simple

そうですねえ。最初の説明だけだと判らなくて当たり前かな。
(暑さのせいかなと思ってしまいましたが)
 
対応方法ですが、
shapeオブジェクトについてはTypeプロパティにその種類が保持されているので、
それで判定するのが良いと思います。

画像であれば、                  msoPicture     という定数(値は13です)が返ります。
フォームコントロールのボタンは、msoFormControl という定数(値は 8です)が返ります。
すみませんが、この情報をもとにご自身でトライしていただけますか?

投稿日時: 25/07/26 04:36:46
投稿者: KOJI2025

>>対応方法ですが、
>>shapeオブジェクトについてはTypeプロパティにその種類が保持されているので、
>>それで判定するのが良いと思います。
自分でやり方を調べ、すぐに実行してみようと思います。

回答
投稿日時: 25/07/26 06:23:44
投稿者: simple

こんな風なことになるかと思います。

Sub 写真自動配置()
    Dim targetRange As Range
    Dim i       As Long
    Dim shp     As Shape

    With ActiveSheet.Pictures
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = 234
        .Height = 170
    End With

    i = 0
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            i = i + 1
            Set targetRange = Cells(i, 2)
            With shp
                .Left = targetRange.Left
                .Top = targetRange.Top
            End With
        End If
    Next
End Sub

ダイレクトにPictureだけを相手にしたほうが得策かもしれません。
 
Picture(s)はオブジェクトブラウザーなどでは非表示オブジェクトになっていて、
重要性は低下しているものかもしれませんが、
Excel2003では堂々と使ってよいものかもしれません。
こんな風に書けます。
Sub 写真自動配置2()
    Dim targetRange As Range
    Dim k       As Long

    With ActiveSheet.Pictures
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = 234
        .Height = 170
    End With

    For k = 1 To ActiveSheet.Pictures.Count
        Set targetRange = Cells(k, 2)
        With ActiveSheet.Pictures(k)
            .Left = targetRange.Left
            .Top = targetRange.Top
        End With
    Next
End Sub

回答
投稿日時: 25/07/26 07:05:36
投稿者: simple

Activesheet.Picturesをindexで列挙していったとき、それが希望の順序なのかは保証の限りではありません。そのあたりはそちらで検討してください。

投稿日時: 25/07/26 10:50:30
投稿者: KOJI2025

> Sub 写真自動配置()
> Sub 写真自動配置2()
「ボタンを押す・写真貼り付け」が成功しました!!!!
2種類とも無事に成功しました!!!
 
simple様のサンプルコードをステップ実行し、
勉強させていただきます。コメントをつけて
同僚に説明させていただきます。
 
職場の写真マニュアル作りが、「ボタンを押す」という、
よりわかりやすい形で自動化できました。
本当にどうもありがとうございました。