Excel VBA質問箱 IV

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

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


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

3869 / 76734

←次へ　｜　前へ→


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

ちろ - 16/10/9(日) 12:08 -


	引用なし

	パスワード

βさん

わざわざプログラムを書いていただきありがとうございます。
思い通りに動きましたヾ(感'∀'激)ﾉﾞ

mosを使う事で画像サイス調整のプログラムもスマートになっており大変勉強になりました。

▼β さん：
>▼ちろさん：
>
>とりあえず一例です。
>不具合あれば指摘願います。
>
>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

7 hits

▼

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