Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

8542 / 76807

←次へ　｜　前へ→


	【73836】Re:写真挿入のVBA

kanabun - 13/2/18(月) 20:07 -


	引用なし

	パスワード

▼wen さん： >・挿入する写真のサイズを「縦60mmに変更」、「横80mmに変更」もしくは「横は縦の縮小と同じ倍率に縮小」 >・挿入するセルの中央に配置 > >以上のコードについて、 mm単位をポイント単位に変換する方法は調べていただくとして、たとえばですがよこサイズを 200ポイント、たてサイズを150 ポイント >　　Const MyX = 200, MyY = 150 '(挿入後画像サイズ：単位ポイント) にしたい、としますと、こんな感じでしょうかね？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ 　　　　　　　　　　　　　　　　　　　　Cancel As Boolean) 　　Dim PicFile As Variant 　　Dim rX As Double, rY As Double 　　Dim Ratio As Double, L As Double, T As Double 　　Dim W As Double, H As Double 　　Const MyX = 200, MyY = 150 '(挿入後画像サイズ：単位ポイント) 　　'［ファイルを開く］ダイアログボックスを表示　　PicFile = Application.GetOpenFilename( _ 　　　　　　　　　　　　"画像ファイル,*.jpg;*.jpeg;*.gif;*.tif;*.png;*.bmp") 　　If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub 　　Application.ScreenUpdating = False 　　'画像を挿入　　With ActiveSheet.Pictures.Insert(PicFile) 　　　　W = .Width 　　　　H = .Height 　　　　rX = MyX / W 　　　　rY = MyY / H 　　　　If rX > rY Then 　　　　　　Ratio = rY 　　　　Else 　　　　　　Ratio = rX 　　　　End If 　　　　.Width = W * Ratio 　　　　.Height = H * Ratio 　　　　'セルの中央（横方向/縦方向の中央）に配置　　　　L = Target.Left ' + (MyX - .Width) / 2 　　　　T = Target.Top　'+ (MyY - .Height) / 2 　　　　　　　　Dim is2010 As Boolean 　　　　is2010 = Val(Application.Version) > 13 　　　　If is2010 Then 'ver14 = XL2010 　　　　　　.CopyPicture 'クリップボードに画像コピー　　　　　　.Delete 'いったん削除　　　　Else 　　　　　　.Left = L 　　　　　　.Top = T 　　　　End If 　　End With 　　If is2010 Then 　　　　Target.Activate 　　　　ActiveSheet.Paste 　　　　With Selection 　　　　　　.Left = L 　　　　　　.Top = T 　　　　End With 　　End If 　　Application.ScreenUpdating = True 　　Cancel = True End Sub ↑このばあい、セルのたて×よこサイズは無関係になりますので、 > 'セルの中央（横方向/縦方向の中央）に配置の部分の処理はありません。