[[20210112201917]]　『セルのサイズに合うよう画像貼り付ける』（ワンツー）　ページの最後に飛ぶ

『セルのサイズに合うよう画像貼り付ける』（ワンツー）

はじめまして。お世話になります。

過去ログを検索しながらトライしていましたが
うまく出来ず、質問させて下さい。

細かく説明させていただくと、
セルに『画像選択』ボタンを設け、
ボタンを押すとファイル参照画面が開き、
画像を選ぶと
セルのサイズに画像の大きさを自動で合わせ
貼り付けてくれるものを作りたいです。

お手数をおかけしますがご教授願います。

＜使用 Excel：Office365、使用 OS：Windows10 ＞

＞過去ログを検索しながらトライしていましたがうまく出来ず
どこがどのようにうまくいかないのですか？

現状のコードを示したうえで、エラーが出るなら、どの場所でなんというエラーがでるのか、エラーにならないが、想定通りのうごきにならないのであれば、××になるはずが、〇〇になってしまうというように説明いただくと、アドバイスできることがあるかもしれません。

（もこな２） 2021/01/12(火) 21:51

    Sub sample()
       Dim picfilename As Variant

       picfilename = Application.GetOpenFilename("*.jpg,*.jpg", 1, "画像の選択", "開く", False)
       If TypeName(picfilename) = "Boolean" Then Exit Sub

       With ActiveSheet.Pictures.Insert(picfilename)
          .Top = ActiveCell.Top
          .Left = ActiveCell.Left
          .Width = ActiveCell.Width
          If .Height > ActiveCell.Height Then .Height = ActiveCell.Height
       End With

    End Sub
（とおりすがり） 2021/01/12(火) 21:58

返信ありがとうございます。
下記のコード(他人が作成したコード)を
使用していましたが、
これだと選択した(カーソルを合わせた)セルに貼り付けてしまい、
不用意に希望しない場所に貼り付けてしまいます。

そのため、セルにボタンを設け、
ボタンのあるセルのみに画像を貼り付けるようにしたいのです。

Public Sub imgpast()

    Dim uFil As FileDialog
    Dim uCel As Range
    Dim uCelW, uCelH As Single

    ' 貼り付けセルの大きさ
    Set uCel = ActiveCell
        uCelW = uCel.Width
        uCelH = uCel.Height
    Set uCel = Nothing

    ' 貼り付ける画像の選択
    Set uFil = Application.FileDialog(msoFileDialogFilePicker)

    With uFil
        .AllowMultiSelect = False
        With .Filters
            .Clear
            .Add "画像ファイル", "*.jpg; *.gif; *.png", 1
        End With
    End With

    If uFil.Show Then
        ActiveSheet.Pictures.Insert(uFil.SelectedItems(1)).Select
        With Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Width = uCelW
            .Height = uCelH
        End With
    End If

    Set uFil = Nothing

End Sub

（ワンツー） 2021/01/12(火) 22:05

提示されたコードは理解できているものとして。

＞ボタンのあるセル
どうやってボタンを作ろうとしてるのかはわかりませんが、１つだけだったら「ActiveCell」を変えるだけでは？

（もこな２） 2021/01/13(水) 07:29

コメント返信：

[ 一覧(最新更新順) ]

[[20210112201917]] 『セルのサイズに合うよう画像貼り付ける』（ワンツー） ページの最後に飛ぶ

[[20210112201917]]　『セルのサイズに合うよう画像貼り付ける』（ワンツー）　ページの最後に飛ぶ