Excel VBA質問箱 IV

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

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


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

3880 / 76734

←次へ　｜　前へ→


	【78483】画像をJPEGに変換

ちろ - 16/10/5(水) 21:17 -


	引用なし

	パスワード

選択したセルの大きさに合わせ圧縮した画像（JPEG)を貼り付けたいのですが
JPEG変換できず苦戦しております。
いろいろなサンプルを参考にしておりますがエラーで止まってしまいます。

下記のコードは画像貼り付けできますがJPEG変換できません。

私の構想は、一度貼り付けた画像を切り取ってJPEGで貼り付けるといった手順でコードを書きたいのですが・・・

アドバイス頂きたくお願いいたします。

Public Sub CCC()

Dim myRange As Range '画像を配置するセル範囲
Dim rX, rY As Double
Dim myDhape, myPic As Variant
Dim Cancel As Boolean
Dim SpObj As Object
　
　
myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
If VarType(myPic) = vbBoolean Then Exit Sub

Set myRange = ActiveCell.MergeArea 'このセル範囲に収まるように画像を縮小する
　　　
Application.ScreenUpdating = False

With ActiveSheet.Pictures.Insert(myPic).ShapeRange
　 rX = myRange.Width / .Width
　 rY = myRange.Height / .Height
　If rX > rY Then
　　.Height = .Height * rY
　　Else
　　.Width = .Width * rX
　End If
.Left = ActiveCell.Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
.Top = ActiveCell.Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置
　　　
End With

Application.ScreenUpdating = True
Cancel = True

End Sub

4 hits

▼

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