画像を貼付け

Sub 写真貼り付け()

Dim Picfile As Variant
'[ファイルを開く]ダイアログボックスを表示

Picfile = Application.GetOpenFilename( _
"画像ファイル,*.jpg;*.jpeg;*.gif;*.tif;*.png;*.bmp")
If VarType(Picfile) = vbBoolean Then Cancel = True: Exit Sub



Application.ScreenUpdating = False

'画像を挿入


Set Picfile = ActiveSheet.Shapes.AddPicture( _
filename:=Picfile, _
LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, _
Width:=0, Height:=0)

Picfile.ScaleHeight 1!, msoTrue
Picfile.ScaleWidth 1!, msoTrue

With Picfile
.LockAspectRatio = True '縦横の比率を固定
.Height = 300# '高さを300ポイントに設定
' '幅を300ポイントなら.Width=300#
End With

Application.ScreenUpdating = True




End Sub
スポンサーサイト

コメントの投稿

非公開コメント

プロフィール

とも

Author:とも
FC2ブログへようこそ!

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
FC2カウンター
検索フォーム
RSSリンクの表示
リンク
QRコード
QR