エクセルの写真挿入時に「図の挿入」から挿入しています。その際、元の写

解決済

質問者：chigasaki5145
質問日時：2010/10/18 18:36
回答数：2件

エクセルの写真挿入時に「図の挿入」から挿入しています。その際、元の写真データのピクセル数に関係なく自分が指定した大きさに設定し自動縮小や拡大して挿入する方法を教えてくだ

通報する

この質問への回答は締め切られました。

質問の本文を隠す

このQ&Aに関連する最新のQ&A

「挿入エクセル」に関するQ&A：エクセルで特定の行だけ行削除、行挿入できないようにロックをかけるには

さらに表示

「マクロ使い方」に関するQ&A： Excelマクロ　アクティブブックの使い方等多数質問がありますので御教授お願いします。

「写真挿入」に関するQ&A：タブレットで写真を挿入した文書を作成したい

「エクセル図」に関するQ&A：写真(平面図)をエクセルに写したい

「挿入」に関するQ&A：ＵＳＢメモリーをＰＣに挿入したら異変がありました。

回答 (2件)

ベストアンサー優先
最新から表示
回答順に表示

No.1ベストアンサー

回答者： hoiho160000
回答日時：2010/10/18 18:45

VBAでなければ無理です

Sub 写真挿入()

Application.Dialogs.Item(xlDialogInsertPicture).Show

With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 250
.ShapeRange.Width = 325
End With
End Sub

選択したセルの左上を基点としてファイル選択ダイアログで選んだ
写真が張り付きます
数字部分を任意の値に設定すれば好きな大きさになります

VBAは　VBEを起動して記載します

このスペースでは説明が難しいので
どこかのサイトを検索して探してください

マクロの使い方　みたいな検索文字でイケると思います

- 6
- 件

通報する

この回答へのお礼

hoiho160000さん
回答ありがとうございました。
少々私には難しい回答でしたが、マクロの設定をすることが出来れば私の悩みを解決できるかと思います
私は現場監督をしており毎日大量の写真整理をこなしています。
その写真を挿入する際にはいつもエクセルには大きく挿入して、それから縮小している現状です。
作業能率の短縮を図れるかと思うとうれしいです。
マクロについて再度調べてみたいと思います。

通報する

お礼日時：2010/10/19 17:58

No.2

回答者： noname#164823
回答日時：2010/10/18 18:51

オートシェイプの四角を書いておき、右クリック

「書式設定」で「サイズ」を指定。

同じダイアログの「色と線」「塗りつぶし」の「色」をクリック。
「塗りつぶし効果」から「図」「図の選択」で目的のファイルを指定し、OK。

四角をコピーしておくと、同じサイズに写真を入れられます。

- 12
- 件

通報する

この回答へのお礼

inu-cyanさん
ありがとうございました
現場監督をしている私は毎日の工事写真整理で大量に写真を扱います
この方法を活用して、日々の労働時間を少しでも縮小できるようにがんばります！！
また、分からないことがあったら助けてください
ありがとうございました

通報する

お礼日時：2010/10/19 17:48

このQ&Aに関連する人気のQ&A

「写真挿入」に関するQ&A： EXCELをJPEGで保存ができますか。

さらに表示

「マクロ使い方」に関するQ&A：条件によって色が変わるエクセル関数を教えてください。

「エクセル図」に関するQ&A：エクセルの図をワードへコピー：セル枠が出現：消す方法がありますか？

「挿入」に関するQ&A：エクセルの表をワードで作成した文章に挿入するには

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

質問する（無料）

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセルで、セルのサイズに合わせて画像を挿入するには？

現在、データ等を記載した商品一覧表を作成しているおります。表のセルの中に商品画像を挿入しているのですが、画像を挿入してから、毎回その度に画像をセルのサイズに手動で変更するのが手間だなーと思っています。
指定したセルのサイズに、自動で画像をサイズ変換してくれる機能はないのでしょうか。
御存じの方おられましたら、よろしくお願いします。

Aベストアンサー

機能としては難しいですが、ＶＢＡを使えば結構簡単に出来るはずです。
１．イメージを置きたいセルの幅、高さの取得。
２．イメージの表示サイズの取得
３．後は比率などでのイメージの修正。
但し、画像の挿入でしたものをあとから変更するのではなく、貼り付けマクロを作成し先ほどのロジックをＶＢＡ化すれば可能。

他の回答も見る

Qエクセルに写真の貼り付けが出来ません。

画像をコピーし、エクセルに貼り付けることが出来ません。（エクセル画面にすると貼り付けを選択することが出来ない状態）ワードでは同じ作業で貼り付けれるのですが、何かの設定がおかしいのでしょうか？
あと、ワードやエクセルに写真をコピーした時、画像が大きくてはみ出してしまうのですが、その大きさを前もって調製することはできるのでしょうか？
その方法を教えてください。宜しくお願いします。

Aベストアンサー

エクセルのバージョンがわかりませんがエクセル2007の場合、エクセルを起動して「挿入」＞「図」＞入れたい画像を選ぶ
で入れられました。

「コピー」ではなく、いったん画像をデスクトップやよく使うフォルダへ保存してから挿入してみてはどうでしょうか？

画像の大きさの変更ですが、エクセルに入れ前に大きさを変えたいということですので、フリーソフトなどでペイントソフトなどを探して、それで画像を加工してから上書き保存や別の名前を付けて保存して、それを挿入してみてはいかがでしょう？

http://www7.ocn.ne.jp/~otoku/free-s-gazousakusei.htm
ここに色々ソフトがあります。
ただ、新らしいソフトを使うということで、そのソフトの使い方になれる必要はあると思います。

他の回答も見る

Qエクセル挿入図の大きさ指定

いつもお世話になります。
さて早速ですが、エクセルで挿入、図、ファイルからの画像の大きさを指定して挿入するにはどうしたらよろしいでしょうか？
ご指導よろしくお願いします。

Aベストアンサー

まず、オートシェープの四角をお望みの大きさに設定、右クリックして
オートシェープの書式設定→塗りつぶしの色→塗りつぶし効果→図
と進んで「参照」ボタンを押して挿入図を選択してください。
オートシェープの大きさになります。

他の回答も見る

Qエクセルで画像を自動的に挿入

エクセルは一般人程度の知識しかありません。
わたしは、デジカメの画像をエクセルに貼り付けて印刷しています。
（A4で、サイズ変更をして）
今までは、画像を貼り付けて、サイズ変更して、１画像ずつ配置していました。
しかし画像数が多いと配置の作業が大変です。画像を選択するだけでサイズ変更して自動的に配置してくれる機能なんてないですかね？
よろしくお願いします。

Aベストアンサー

検索すればそこかしこに情報があると思います。
我田引水ですが、
http://okwave.jp/qa3864319.html
更に、上記記事中のリンク先では、マクロの作り方も含めて説明してくれていますので、ご覧下さい。

他の回答も見る

Qエクセルへ画像挿入、元サイズが同じなのに大きさ違う

デジカメの写真の大きさが大きすぎるので、フォトショップで640×480ピクセルくらいに小さくしてから、エクセルに貼り付けています。

でも、貼り付けるとものすごく小さくなる場合があります。

通常はエクセルのプロパティでみると原型サイズ縦16.97ｃｍ　横22.58ｃｍなのですが、

小さいとき、縦3.48ｃｍ　横4.65ｃｍとなっています。

今、気付いたのですが、カメラが違うようで、640×480に縮小する前は大きい方は4000×3000、小さい方は2592×1944でした。

でも、同じ640×480にしたのだから、エクセルに挿入したら同じサイズになるのではないですか？

小さく挿入された方はエクセル上でサイズを大きくすると画像が粗くなるのでしょうか？

エクセル上では、6ｃｍ×8ｃｍくらいにするのですが、見た目ではよくわかりません。

粗くならないなら、割り切ってエクセル上で拡大して使うのですが・・・

詳しい方、ご教授ください。

Aベストアンサー

同じ解像度72dpiでもサイズが異なるとの事で原因は分かりかねますが、試しに解像度変換君というフリーソフトで解像度を変更して遊んでみました。当方愛用のVixでJPEG保存すると、解像度情報は保存されない様ですが、エクセルに取り込んだ時は96dpiと同じ扱いでした。200dpiに変更して取り込んでみると、シート上で小さく表示されました。エクセルも結構まともなのですね。
さて、回答ではありませんが、エクセルにクリップボード経由で画像を貼り付けて巨大化するのを防止するには、貼り付けた後に、ワークシート上でサイズを調整し、Ctrl+xで一旦切り取り、形式を指定して貼り付けでJPEGを指定すると、縮小した画素数かつ、JPEG形式で貼り付けられますので、ファイルサイズの巨大化を防止できます。（画像は当然眠くなります）。ご参考まで。

他の回答も見る

Q複数の画像ファイルを挿入したい

工事の仕事をしています。
報告書をエクセルで書いて出すのですが、
現場の写真を大量に撮影して貼り付けなければなりません。

「挿入」→「ファイルから」で一枚一枚貼り付けているのですが手間でなりません。

デジカメで撮影した写真なのでファイル名は連番です。
一括でワークシートにズラッと並べて挿入することはできないのでしょうか?

週末1-200枚の写真を貼る為に残業するのは堪えます。
良い知恵をお貸し下さい。

Aベストアンサー

工事写真票の作成ですか？報告書の提出時期ですものね。(^^;)

工事写真ということで、次の点が重要になるかと思います。

1.　貼付けられる順番
　　工事の様子を時間を追って撮影している場合、順番が重要です。
2.　リサイズの問題
　　工事写真は正確性が求められます。リサイズする場合、縦横比を固定すべきです。

1と2をクリアしつつ、貼付けを楽にするには、EXCELではマクロしか解決方法がありません。個人的にはVIXをお勧めしますが、一応EXCELでのマクロをアップします。貼付け後のサイズはセルの高さにあわせています。必要があれば、コードをカスタマイズして下さい。

ただ、他の方からもご指摘があるとおり、EXCELに200枚の画像は無茶ですね。複数のブックに切り分けましょう。

なお、マクロ[InsertPictures]は#2.papayukaさんのコードをかなり拝借しておりますし、配列のソートプログラムも以前どこかで教えて頂いたものです。クイックソートの方が早いのですが、長くなるので、バブルソートで済ませています。

以下コード。

Option Explicit
Sub InsertPictures()
　　
　　Dim fName As Variant
　　Dim i As Long
　　Dim Pict As Picture

　　fName = Application.GetOpenFilename("JPGファイル, *.jpg", MultiSelect:=True)
　　If IsArray(fName) Then
　　　　Application.ScreenUpdating = False
　　　　'配列に格納されたファイル名をソート
　　　　BubbleSort fName, True
　　　　For i = 1 To UBound(fName)
　　　　　　Set Pict = ActiveSheet.Pictures.Insert(fName(i))
　　　　　　With Pict
　　　　　　　　.TopLeftCell = ActiveCell
　　　　　　　　.ShapeRange.LockAspectRatio = msoTrue
　　　　　　　　'どちらかをコメントアウト
　　　　　　　　.ShapeRange.Height = ActiveCell.Height 'セルの高さリサイズ
　　　　　　　　'.ShapeRange.Width = ActiveCell.Width 'セルの幅にリサイズ
　　　　　　　　ActiveCell.Offset(0, 1) = fName(i) 'ファイル名書込み
　　　　　　End With
　　　　　　ActiveCell.Offset(2, 0).Activate
　　　　　　Application.StatusBar = "処理中：" & i & "/" & UBound(fName) & "枚目"
　　　　Next i
　　End If
　　With Application
　　　　.StatusBar = False
　　　　.ScreenUpdating = True
　　End With
　　Set Pict = Nothing
　　MsgBox i & "枚の画像を挿入しました", vbInformation

End Sub

'値の入替え
Public Sub Swap(ByRef Dat1 As Variant, ByRef Dat2 As Variant)

　　Dim varBuf As Variant
　　varBuf = Dat1
　　Dat1 = Dat2
　　Dat2 = varBuf

End Sub

'配列のバブルソート
Public Sub BubbleSort(ByRef aryDat As Variant, _
　　Optional ByVal SortAsc As Boolean = True)

　　Dim i As Long
　　Dim j As Long
　　For i = LBound(aryDat) To UBound(aryDat) - 1
　　　　For j = LBound(aryDat) To LBound(aryDat) + UBound(aryDat) - i - 1
　　　　　　If aryDat(IIf(SortAsc, j, j + 1)) > aryDat(IIf(SortAsc, j + 1, j)) Then
　　　　　　　　Call Swap(aryDat(j), aryDat(j + 1))
　　　　　　End If
　　　　Next j
　　Next i

End Sub

他の回答も見る

Qエクセルに画像を貼付け縮小する作業をマクロにしたいのですが、

エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、
分からない部分があって困ってます。

(1)挿入したいセルにカーソルを合わせる
(2)マクロ
　挿入－図－ファイル－図の挿入－図の書式設定－サイズ－30％

この作業を覚えさせると以下になりました。

Sub Macro3()
ActiveSheet.Pictures.Insert("C:\Documents and Settings\デスクトップ\1.JPG") _
.Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 360#
Selection.ShapeRange.Width =...続きを読む

Aベストアンサー

私も画像の取り込みでマクロをいじった経験があります。
こういうのはどうでしょう？（今動作確認できないのですが…）

Sub test()
ActiveSheet.Pictures.Insert(Application.GetOpenFilename).Select
Selection.Height = Selection.Height * 0.3
Selection.Width = Selection.Width * 0.3
End Sub

他の回答も見る

Qエクセルに画像(JPG)を取り込む作業を簡単にしたい！！

エクセルに画像(JPG)を取り込むときに、その画像のファイル名をセルに入力するとその画像が取り込めますか？？
毎回、挿入から画像のある場所を指定してやっているととっても時間がかかります・・・。
簡単にできる方法はないでしょうか？？
マクロがわからないので、やさしく教えてもらえると助かります。

Aベストアンサー

画像挿入ダイアログをマクロで出したいなら、

Sub Test1()
　　Application.Dialogs(xlDialogInsertPicture).Show
End Sub

単純に図の挿入ボタンをユーザー設定でツールバーに置いておくのと変わりませんが。

他には、
例えば画像のフルパスを入力したセルを選択し、下記のようなマクロを実行すると画像が挿入されます。

Sub Test2()
Dim pict
On Error Resume Next
　　If Dir(ActiveCell.Text) = "" Then Exit Sub
　　Set pict = ActiveSheet.Pictures.Insert(ActiveCell.Text)
　　pict.T...続きを読む

他の回答も見る

Qオブジェクトのサイズが勝手に変わる

excel 2013を使用しています。

下記と同様のことが、発生し作りたいものが作れません。

https://support.microsoft.com/kb/2510274/ja?wa=wsignin1.0

ワードアートと図形の四角形(ワードアートを囲む)を、組み合わせて作りたいけど、
サイズを指定しても、勝手にサイズが変わると、作れないです。

皆さんは、どうしてますか？
１、頑張って、サイズ変更が小さくなるサイズを作る。
２、他のソフト(PowerPointやWord)で作る。

Aベストアンサー

Excelって、関数計算に重点を置く設計になっているので、表示の問題は二の次になっています。セル中に収まっている文字でも、プレビューや実際に印刷すると、見えない文字が出てくるってこと、結構ありますよね。なので、どうしてもサイズを変えないことを優先するのであれば、他のソフトを使うしかないと思います。どうしてもExcelをと言うことであれば、ズームスライダーを固定して図形を作成（80%なら、80％にした状態で4cm四方の四角を作成し、80%を維持）するしかないと思います。私が作るドキュメントでは四角の中に書いた文字がはみ出なければいいようなドキュメントしか作成しないので、今まで正直気になりませんでした。

他の回答も見る

Q任意フォルダから画像をすべてエクセルの指定マスに貼り付けをしたい

ネットでいろいろ検索し、試してみましたが自分の思うような仕上がりにならず困っています。

実施したい内容としては、マクロで
①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
②マクロを開始するとフォルダを選ぶ画面が現れる
③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
④画像は、セルの大きさに合わせて自動調整される
というものです。

1枚ずつを選んでセルに自動調整で貼り付けるということは真似事でできましたが、希望の内容をできるようにしようとすると、かなり難易度が高くお手上げ状態です。
このプログラムをどのように改修すれば可能になるかお教えください。

Sub 図11()

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("B6").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

' 次の貼り付け先を選択（アクティブセルにする）[例：5個下のセル]
ActiveCell.Offset(5).Select

Set PIC = Nothing
Next i

' 終了
Application.ScreenUpdating = True

End Sub

よろしくおねがいします。
※マクロはほぼ初心者です。大体がネットからコピペをして使っている程度のレベルです。

Aベストアンサー

>①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
>②マクロを開始するとフォルダを選ぶ画面が現れる
>③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
>④画像は、セルの大きさに合わせて自動調整される

①は、A2で始まり、横に4進み、下に2進むという数列を設けています。
②は、ご存知のShell のBrowseForFolderを利用しましたが、他にもあるでしょう。
問題は③かな。一応、 ''安全のため（上限を設定)　という箇所を設けましたが、不要なら、コメント・アウトしてください。また、DoEvents も入れておきました。
④は、何も手を付けていません。
コメント・アウトした部分で不要なら削除してください。

'//
Sub 図11R()
　'No. 9024507
　Dim strFilter As String
　Dim Filenames() As Variant
　Dim fName As Variant, ext As String
　Dim PIC As Picture
　Dim k As Long, m As Long
　Dim i As Long, j As Long
　Dim cnt As Long
　Dim FirstRng As Range
　Dim r As Range
　Dim Sel_Folder As Object, Sel_Path As String
　cnt = 0 'カウントの初期値
　'貼り付け最初のセル
　Set FirstRng = Range("A2")
　
　 Set Sel_Folder = CreateObject("Shell.Application"). _
　　　 BrowseForFolder(0, "フォルダを選択してください", 5)

　　If Not Sel_Folder Is Nothing Then
　　　　Sel_Path = Sel_Folder.Self.Path
　　Else
　　　Exit Sub
　　End If
　
　' 「ファイルを開く」ダイアログでファイル名を取得
　ChDir Sel_Path
'　strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
'　Filenames = Application.GetOpenFilename( _
'　FileFilter:=strFilter, _
'　Title:="図の挿入(複数選択可）", _
'　MultiSelect:=True)
　fName = Dir("*.*", vbNormal)
　Do While fName <> ""
　　If fName <> "." And fName <> ".." Then
　　　ext = Mid(fName, InStrRev(fName, ".") + 1)
　　　If InStr(1, "jpg,jpeg,gif,bmp,png", ext, 1) > 0 And Not fName Like "#*" Then
　　　　cnt = cnt + 1
　　　　DoEvents
　　　　ReDim Preserve Filenames(1 To cnt)
　　　　Filenames(cnt) = fName
　　　 ''安全のため（上限を設定)
　　　　If cnt > 100 Then Exit Do
　　　End If
　　End If
　　fName = Dir()
　Loop
　If cnt = 0 Then Exit Sub
　
　' ファイル名をソート
　Call BubbleSort_Str(Filenames, True, vbTextCompare)
　
　'' 貼り付け開始セルを選択
　'Range("B6").Select
　
　' マクロ実行中の画面描写を停止
　Application.ScreenUpdating = False
　' 順番に画像を挿入
　k = LBound(Filenames)
　m = UBound(Filenames)
　
　For j = 1 To Int(m / 4) + Abs(m Mod 4 > 0)
　　For i = 1 To 4
　　　Set PIC = ActiveSheet.Pictures.Insert(Filenames(k))
　　　Set r = FirstRng.Cells(1 + (j - 1) * 2, i)
　　　
　　　'-------------------------------------------------------------
　　　' 画像の各種プロパティ変更
　　　'-------------------------------------------------------------
　　　With PIC
　　　　.Top = r.Top ' 位置：アクティブセルの上側に重ねる
　　　　.Left = r.Left ' 位置：アクティブセルの左側に重ねる
　　　　.Placement = xlMove ' 移動するがサイズ変更しない
　　　　.PrintObject = True ' 印刷する
　　　End With
　　　With PIC.ShapeRange
　　　　.LockAspectRatio = msoTrue ' 縦横比維持
　　　　' 画像の高さをアクティブセルにあわせる
　　　　' 結合セルの場合でも対応
　　　　.Height = r.MergeArea.Height
　　　End With
　　　
　　　' 次の貼り付け先を選択（アクティブセルにする）[例：5個下のセル]
　　　' ActiveCell.Offset(5).Select
　　　
　　　Set PIC = Nothing
　　　k = k + 1
　　　If k >= m Then Exit For
　　Next i
　Next j
　Application.ScreenUpdating = True
　ChDir ThisWorkbook.Path
End Sub