![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?c9bd177)
こんにちは、VBAに関しまして、今あるコードに、追加頂きたいというお願いです。。。
■現状のマクロ
作動させる→画像選択画面→画像ファイルを選択→エクセルに画像を貼り付け・保存場所・ファイル名を記載
というものなのですが、ここに「画像の幅」と「画像の高さ」も書き出すようにするために
コードの書き換えをお願いしたいです。。
現状のマクロも自分で作成したものではないため、自分で修正や更新ができません。
申し訳ありません。。。
現状のマクロを下記に記載させて頂きます。
---------------------------------------------
Sub 画像とファイル名書き出し実サイズバージョン()
'ユーザーフォーム閉じる
Unload image
Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Picture
' 「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可)", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub
' ファイル名をソート
Call BubbleSort_Str(Filenames, True, vbTextCompare)
' 貼り付け開始セルを選択
'Range("C3").Select
' マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
' 順番に画像を挿入
For i = LBound(Filenames) To UBound(Filenames)
Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))
'-------------------------------------------------------------
' 画像の各種プロパティ変更
'-------------------------------------------------------------
With PIC
.Top = ActiveCell.Top ' 位置:アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置:アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
.PrintObject = True ' 印刷する
End With
With PIC.ShapeRange
.LockAspectRatio = msoTrue ' 縦横比維持
' 画像の高さをアクティブセルにあわせる
' 結合セルの場合でも対応
'.Height = ActiveCell.MergeArea.Height
End With
ActiveCell.Offset(0, 1) = Filenames(i) '保存場所&ファイル名
ActiveCell.Offset(0, 2) = Dir(Filenames(i)) 'ファイル名
' 次の貼り付け先を選択(アクティブセルにする)[→これは削除例:C列とF列交互かつ8個下のセル]
ActiveCell.Offset(1, 0).Activate
Next i
' 終了
Application.ScreenUpdating = True
MsgBox i - 1 & "枚の画像を挿入しました", vbInformation
End Sub
' バブルソート(文字列)
Private Sub BubbleSort_Str( _
ByRef Source As Variant, _
Optional ByVal SortAsc As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare)
If Not IsArray(Source) Then Exit Sub
Dim i As Long, j As Long
Dim vntTmp As Variant
For i = LBound(Source) To UBound(Source) - 1
For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
If StrComp(Source(IIf(SortAsc, j, j + 1)), _
Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
vntTmp = Source(j)
Source(j) = Source(j + 1)
Source(j + 1) = vntTmp
End If
Next j
Next i
End Sub
![「【エクセルVBA】選択した画像をエクセル」の質問画像](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/b/713446_5b970d0253d96/M.png)
A 回答 (1件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
こんにちは
サイズは表示中のサイズではなく、元のデータのサイズという意味ですよね?
一旦、画像をLoadPictureで読み込むようにすれば、Width、Height属性からサイズを取得可能なようです。
ただし、返される値がポイント単位なので換算が必要です。
http://officetanaka.net/excel/vba/tips/tips87.htm
ご回答ありがとうございます!!
また、説明不足しておりまして申し訳ありませn。。
>表示中のサイズではなく、元のデータのサイズという意味
はい、おっしゃる通りです!
教えて頂いたページのマクロを実行(ページに書いてあるマクロのみをそのまま実行)してみたのですが、pngのファイルだとエラーになってしまい実行できませんでした。。。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
- Visual Basic(VBA) サブフォルダ(データ)にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2 2 2022/08/14 15:46
- Visual Basic(VBA) エクセルのマクロについて教えてください。 7 2023/07/04 09:18
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) エクセルVBAについて 8 2022/07/13 22:41
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
このQ&Aを見た人はこんなQ&Aも見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
マウスで選択した図形のみVBAで移動したい。
Visual Basic(VBA)
-
EXCELで特定のセルに表示された項目をヘッダーやフッターに出力するには
Excel(エクセル)
-
エクセル マクロで画像を指定したコマへ移動する
Excel(エクセル)
-
-
4
エクセルマクロでシート内にある画像のみを選択する
Excel(エクセル)
-
5
任意フォルダから画像をすべてエクセルの指定マスに貼り付けをしたい
Visual Basic(VBA)
-
6
VBAで選択した画像を貼り付けたい
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
Excel内での検索結果をシート...
-
エクセル 数字をすべて○などの...
-
Excelでセルをクリックす...
-
エクセルでの検索ボックスの作...
-
現在のセルの位置を返す関数は...
-
Excelで、図形内の文字をセルに...
-
クリックすると文章が表示され...
-
Excelで挿入した図をセルの中央...
-
セルがクリックされた回数をカ...
-
フォントの色を指定して削除出...
-
エクセルでセルをダブルクリッ...
-
未記入がある場合はマクロを実...
-
シート保護とグループ化機能を...
-
エクセル 未入力セルがあると...
-
エクセルでページ数をあるセル...
-
マクロを実行すると画像がズレ...
-
EXCELのセルや文字色の反映
-
Excel2007 色のカウント (VBA)
-
セル背景や文字を点滅させる方法
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
エクセル 数字をすべて○などの...
-
Excel内での検索結果をシート...
-
太字に設定されているセルの個...
-
クリックすると文章が表示され...
-
Excelで挿入した図をセルの中央...
-
【マクロ】ファイル名の変更に...
-
Excelで、図形内の文字をセルに...
-
マクロを実行すると画像がズレ...
-
Excel ハイパーリンクのURLを別...
-
フォントの色を指定して削除出...
-
Excelでセルをクリックす...
-
Excel2007 色のカウント (VBA)
-
エクセルでの検索ボックスの作...
-
現在のセルの位置を返す関数は...
-
エクセル マクロ チェックボックス
-
VBA 見つからなかった時の処理
-
アポストロフィーの一括挿入 ...
-
エクセルでPDFリンクを大量...
-
セルの値が変ると自動でマクロ...
おすすめ情報