Excel VBA質問箱 IV

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

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


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

3870 / 76734

←次へ　｜　前へ→


	【78493】Re:画像をJPEGに変換

β - 16/10/8(土) 21:57 -


	引用なし

	パスワード

▼ちろさん：

とりあえず一例です。
不具合あれば指摘願います。

Sub Test()
　　Dim myRange As Range　　'画像を配置するセル範囲
　　Dim myPic As Variant

　　Set myRange = ActiveCell.MergeArea　　'このセル範囲に収まるように画像を縮小する
　　
　　myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
　　If VarType(myPic) = vbBoolean Then Exit Sub

　　With ActiveSheet.Pictures.Insert(myPic)
　　　　.ShapeRange.LockAspectRatio = msoTrue
　　　　.Cut
　　　　ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
　　　　DoEvents
　　　　With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
　　　　　　.Width = myRange.Width
　　　　　　If .Height > myRange.Height Then .Height = myRange.Height
　　　　　　.Top = myRange.Top + (myRange.Height - .Height) / 2
　　　　　　.Left = myRange.Left + (myRange.Width - .Width) / 2
　　　　End With
　　End With
　　
End Sub

6 hits

▼

【78483】画像をJPEGに変換 ちろ 16/10/5(水) 21:17