Excelマクロでセルをダブルクリックすると画像が選べるようにする方法| OKWAVE

マクロで画像挿入の質問です

マクロ　初心者です。ワークシート指定して、ダブルクリック等を使っての画像選択、貼り付け＆セルの大きさに合わせる）ことはできるのですが、ダブルクリック等ではなく、手動でマクロを実行して指定のセル（B37）に貼り付けることはできるでしょうか？（セルの大きさに画像が変換するのは生かしたまま） Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)を sub マクロ名（）にして、Moduleに貼り付けて実行したら myAD2 = Target.Address 上記場所でエラーになってしまいます。どのように変更したら、できるでしょうか？または、できる手段はないのでしょうか？ご教授お願いします。使用ベースマクロは以下です。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True '===============画像選択 myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If '===============画像の掃除 For Each mySP In ActiveSheet.Shapes myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete Next '===============画像の貼り付け Set mySP = ActiveSheet.Pictures.Insert(myF) '===============タテヨコの縮尺を保持 myHH = Target.Height / mySP.Height myWW = Target.Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Target.Width Else mySP.Height = Target.Height mySP.Width = mySP.Width * myHH End If '===============中央へ調整 myHH2 = (Target.Height / 2) - (mySP.Height / 2) myWW2 = (Target.Width / 2) - (mySP.Width / 2) mySP.Top = Target.Top + myHH2 mySP.Left = Target.Left + myWW2 Set mySP = Nothing End Sub

【急】Excelで写真張り付けマクロを書き換えたい

下記マクロを拾い利用しようと思っているのですが、以下の点を急ぎ修正しないと使えません。修正方法などが分からないので、ご教示ください。要件：・セルをクリックして写真選択して張り付け、・縦横比を変えずに、クリックした結合セルサイズ内に収める。・写真は縦横混在に対応・写真をセンターに配置する。・セルのサイズは変動する。現状の問題点：・縦向きの写真を挿入した際にセルの上下から画像がはみ出してしまう。以下コードーーーーーーーーーーーーーーー Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Cancel = True '画像選択コマンド myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "編集する場合はF2を押下してください。" Exit Sub End If '画像データの再構築 For Each mySp In ActiveSheet.Shapes myAD1 = mySp.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySp.Delete Next 'リサイズして画像の貼り付け Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _ SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _ Width:=0, Height:=0) mySp.ScaleHeight 1, msoTrue mySp.ScaleWidth 1, msoTrue '縮尺を変えずにリサイズ If mySp.Width > Target.Width Then mySp.Width = Target.Width * 0.99 If mySp.Height > Target.Height Then mySp.Height = Target.Height * 0.99 'センター中心に配置 myHH2 = (Target.Height / 2) - (mySp.Height / 2) myWW2 = (Target.Width / 2) - (mySp.Width / 2) mySp.Top = Target.Top + myHH2 mySp.Left = Target.Left + myWW2 Set mySp = Nothing End Sub 以上ご協力の程宜しくお願い申し上げます。

VBAの修正コードを教えてください（初心者）

いつもお世話になっております。下記のVBAコードを使わせて頂き、自分で作成したエクセルにセルに合わせて自動で画像データを添付するようにしたいのですが。 (1)タテヨコの縮尺を保持⇒セルに合わせて縦横の変倍を行う (2)又は、貼付部のセルのサイズは決まっているのでサイズを指定して貼り付けるとなるように修正したいのですが、なにぶんVBAは初心者なもので、全くわかりません。どなたかご指導を宜しくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Cancel = True '===============画像選択 myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If '===============画像の掃除 For Each mySP In ActiveSheet.Shapes myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete Next '===============画像の貼り付け Set mySP = ActiveSheet.Pictures.Insert(myF) '===============タテヨコの縮尺を保持 myHH = Target.Height / mySP.Height myWW = Target.Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Target.Width Else mySP.Height = Target.Height mySP.Width = mySP.Width * myHH End If '===============中央へ調整 myHH2 = (Target.Height / 2) - (mySP.Height / 2) myWW2 = (Target.Width / 2) - (mySP.Width / 2) mySP.Top = Target.Top + myHH2 mySP.Left = Target.Left + myWW2 Set mySP = Nothing End Sub

教えてください。

教えてください。初めての投稿になります、書き込みなど不慣れ点あるかも知れませんが宜しくお願いいたします。エクセル2007のマクロ、ＶＢＡ書き込みについて指定された結合セルのみに画像挿入したいのです下記のＶＢＡではすべてのセルにたいして画像挿入されてしまいます、結合セル三か所のみ反映したいのですが。 rivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Cancel = True '===============画像選択 myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If '===============画像の掃除 For Each mySP In ActiveSheet.Shapes Debug.Print mySP.Name If InStr(mySP.Name, "Drop Down") = 0 Then myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete End If Next '===============画像の貼り付け Set mySP = ActiveSheet.Pictures.Insert(myF) '===============タテヨコの縮尺を保持 myHH = Target.Height / mySP.Height myWW = Target.Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Target.Width Else mySP.Height = Target.Height mySP.Width = mySP.Width * myHH End If '===============中央へ調整 myHH2 = (Target.Height / 2) - (mySP.Height / 2) myWW2 = (Target.Width / 2) - (mySP.Width / 2) mySP.Top = Target.Top + myHH2 mySP.Left = Target.Left + myWW2 Set mySP = Nothing End Sub セル指定縦Ｂ９からＢ２１（１９５（２６０ピクセル）横ＢからＥ（４０．０２（３４０ピクセル）その他２つの結合セルがあります、サイズはすべて同じです縦Ｂ２４からＢ３６　　縦Ｂ３９からＢ５１横ＢからＥ　　　　　　　横ＢからＥ　何分素人ですので、どのランに書き込めばいいのかもわかりませんいろんなＶＢＡをコピーして貼り付けましたがうまくいきませんでした宜しくご享受お願いいたします。　　　

VBAの写真貼り付けコードについて教えてください。

写真をダブルクリックで簡単に貼り付けられるVBAのプログラムを友人に貰ったのですが、追加で図の外枠に黒の2.5ptくらいの線を縁取る文を追加しようと、マクロで記録したプログラムを入れてみたのですが上手く動作しません。コードが --------------------------------------------------------------------------------- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Cancel = True If Target.MergeCells = False Then Exit Sub '===============画像選択 myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then Exit Sub End If '===============画像の掃除 For Each mySP In ActiveSheet.Shapes myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete Next '===============画像の貼り付け Set mySP = ActiveSheet.Pictures.Insert(myF) '===============タテヨコの縮尺を保持 myHH = Target.Height / mySP.Height myWW = Target.Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Target.Width Else mySP.Height = Target.Height mySP.Width = mySP.Width * myHH End If '===============中央へ調整 myHH2 = (Target.Height / 2) - (mySP.Height / 2) myWW2 = (Target.Width / 2) - (mySP.Width / 2) mySP.Top = Target.Top + myHH2 mySP.Left = Target.Left + myWW2 Set mySP = Nothing End Sub ------------------------------------------------------------------------- お願いいたします。

VBAの操作方法について教えてください（初心者）

いつもお世話になっております。以下のような操作をエクセルにおいて行いたいのですが。 (1)エクセルのセルをクリック！ (2)エクスプローラー起動！画像データを選択！ (3)セルに合わせて縦横変倍をかけてデータ（JPGデータ）を貼付！同様の操作が可能な以下のVBAが公開されていたので使わせて頂こうと考えているのですが、操作方法が分かりません。 VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "Sheet1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Cancel = True '===============画像選択 myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If '===============画像の掃除 For Each mySP In ActiveSheet.Shapes myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete Next '===============画像の貼り付け Set mySP = ActiveSheet.Pictures.Insert(myF) '===============タテヨコの縮尺を保持 myHH = Target.Height / mySP.Height myWW = Target.Width / mySP.Width If myHH > myWW Then mySP.Height = mySP.Height * myWW mySP.Width = Target.Width Else mySP.Height = Target.Height mySP.Width = mySP.Width * myHH End If '===============中央へ調整 myHH2 = (Target.Height / 2) - (mySP.Height / 2) myWW2 = (Target.Width / 2) - (mySP.Width / 2) mySP.Top = Target.Top + myHH2 mySP.Left = Target.Left + myWW2 Set mySP = Nothing End Sub 作成したエクセルのVBエディタを開く⇒標準モジュールの作成⇒上記VBAをコピペ・・・正直わかりません。昨日一晩かけて調べたのですがわかりません。どなたか宜しくお願い致します。

excel　マクロ　画像挿入

以下のマクロでリンク貼り付けではない　画像挿入を作成しようと思いましたがエラーになります詳しい方　修正　お願いいたします当方のしたい事としましては選択したセルでのみに画像挿入　リンクではない画像貼り付け以下例では　B3,B17,B31,B46,B60,B74　セルをダブルクリックすればそこに画像を挿入です Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myF As Variant Dim mySp As Object Dim myAD1 As String Dim myAD2 As String Dim myHH As Double Dim myWW As Double Dim myHH2 As Double Dim myWW2 As Double If Not Intersect(Range("B3,B17,B31,B46,B60,B74"), Target) Is Nothing Then myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") Cancel = True '===============画像選択 myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If '===============画像の掃除 For Each mySp In ActiveSheet.Shapes myAD1 = mySp.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySp.Delete Next '===============画像の貼り付け Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _ SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _ Width:=0, Height:=0) '★　とりあえず　縦横０で。 mySp.ScaleHeight 1, msoTrue '★元のサイズに戻す mySp.ScaleWidth 1, msoTrue '★元のサイズに戻す '===============タテヨコの縮尺を保持 If mySp.Width > Target.Width Then mySp.Width = Target.Width If mySp.Height > Target.Height Then mySp.Height = Target.Height '===============中央へ調整 myHH2 = (Target.Height / 2) - (mySp.Height / 2) myWW2 = (Target.Width / 2) - (mySp.Width / 2) mySp.Top = Target.Top + myHH2 mySp.Left = Target.Left + myWW2 Set mySp = Nothing End Sub

エクセル　マクロ

エクセルのある特定のセルをダブルクリックすると画像ファイルを参照しにいき貼りつけたい画像ファイル選ぶとそのセルの大きさに合わせて画像ファイルがそのセルに貼りつくというマクロが以下の通りなんですが Excel2003からExcel2007へ変更すると画像ファイルの貼りつく位置がダブルクリックしたセルではない所に貼りつくようになりました参照や大きさなどはちゃんと機能しているようですどこを変更すればよいでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range('特定のセル)) Is Nothing Then Exit Sub Cancel = True Dim myPic Dim myRange As Range Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target 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 = .Left + (myRange.Width - .Width) / 2 .Top = .Top + (myRange.Height - .Height) / 2 End With Application.ScreenUpdating = True Cancel = True End Sub

エクセル２０１０　挿入画像の圧縮　VBA

お世話になります。エクセル２０１０を使用しています。写真帳を作成しダブルクリックすれば写真が挿入されるようVBAにて作成しましたが、写真の解像度が高いので挿入するたびに画像が圧縮するようにVBAを組みたいのですが、どなたかご教示ください。具体的には一同挿入した画像を一度コピーし、再度貼り付ける・・・という動作かなと考えているのですが、マクロの記憶では記録されず・・・困っております。現在の写真帳の構文は Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim myF As Variant Dim mySp As Object Dim myAD1 As String Dim myAD2 As String Dim myHH As Double Dim myWW As Double Dim myHH2 As Double Dim myWW2 As Double '挿入のセルを指定 If Application.Intersect(Target, Range("d6,d23,d40")) Is Nothing Then Exit Sub Cancel = True Application.ScreenUpdating = False End If '写真挿入 Next myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If myPic = False Then MsgBox "画像を選択してください" Exit Sub End If Set myRange = Target 'このセル範囲に収まるように画像を縮小する Application.ScreenUpdating = False With ActiveSheet.Shapes.AddPicture(myPic, False, True, myRange.Left, myRange.Top, myRange.Width, myRange.Height) rX = 0.85 rY = 1 If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 .ZOrder msoSendToBack '最背面へ移動 End With Application.ScreenUpdating = True Cancel = True End Sub 上記に.CUT　などを書き足せばよいのか・・・ →エラーばかりで動かなったので。。　こちらに質問することにしました。どうぞ、よろしくお願いします。

VBAの内容の修正をお願いさせて頂きます

VBAの内容の修正をお願いしたく質問させて頂きます。知人にExcel200７でシートのアルバムに写真をクリックで貼り付けられ、また別に張り付けてあるボタンでフォルダーを選択するとフォルダー内の写真を一括貼り付けるVBAを作成してもらいました。ところがExcel2013で作成したものは他のPCで見られず、『リンク先が分からない・・・』と言った内容のメッセージが表示されます。張り付けたボタンをクリックすると、フォルダーの選択はできますが、その後『実行時”1004”　　PicturesクラスのInsertプロパティを取得できません』と言うメッセージが出ます。残念ながら知人もよくわかりません。表示内容がお分かりの方はぜひとも修正のご指導をお願いします。写真のアルバムはA4サイズに横２×縦４の8枚を並べています。セルの結合が8枚あり、その場所をクリックすることで1枚1枚貼り付けることができます。また、VBAでフォルダ内で番号順に並んでいる写真がばらばらに貼りついて今します。その部分も分かりましたら、よろしくお願いします。 VBA　左上表示：(General) 右上表示：画像貼り付け Sub 画像貼り付け() '===============フォルダ選択 Set myPath = CreateObject("Shell.Application") _ .BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, 0) If myPath Is Nothing Then Exit Sub If myPath.Items Is Nothing Then Exit Sub If myPath.Items.Item Is Nothing Then Exit Sub フォルダ = myPath.Items.Item.Path Set myPath = Nothing '===============画像の掃除 ' For Each mySP In ActiveSheet.Shapes ' myAD1 = mySP.TopLeftCell.MergeArea.Address ' myAD2 = Target.Address ' If myAD1 = myAD2 Then mySP.Delete ' Next 元シト = ActiveSheet.Name セル = Array("C4", "AO4", "C21", "AO21", "C38", "AO38", "C55", "AO55") i = 8 Set myFS = CreateObject("Scripting.FileSystemObject") For Each myF In myFS.GetFolder(フォルダ).Files myEXT = LCase(myFS.GetExtensionName(myF)) If myEXT = "jpeg" _ Or myEXT = "jpg" _ Or myEXT = "gif" _ Or myEXT = "tiff" _ Or myEXT = "bmp" _ Or myEXT = "png" _ Or myEXT = "tif" Then If i > 7 Then i = 0 Sheets(元シト).Copy after:=Sheets(Sheets.Count) End If '===============画像の貼り付け Set mySP = ActiveSheet.Pictures.Insert(myF) myMA = Range(セル(i)).MergeArea.Address '===============タテヨコの縮尺を保持 myHH = Range(myMA).Height / mySP.Height myWW = Range(myMA).Width / mySP.Width If myHH > myWW Then mySP.Height = Range(myMA).Height mySP.Width = Range(myMA).Width Else mySP.Height = Range(myMA).Height mySP.Width = Range(myMA).Width End If '===============中央へ調整 myHH2 = (Range(myMA).Height / 2) - (mySP.Height / 2) myWW2 = (Range(myMA).Width / 2) - (mySP.Width / 2) mySP.Top = Range(myMA).Top + myHH2 mySP.Left = Range(myMA).Left + myWW2 Set mySP = Nothing i = i + 1 End If Next Set myFS = Nothing End Sub

エクセル貼付けの画像がメール添付で表示されません

下記のようなVBA（ネット公開されているものを利用させていただいています）を使用し、エクセルに画像を貼り付けています。画像を貼り付けたエクセルを保存後、メールに添付すると貼り付けた画像が表示されなくなります。ファイルの容量も少なく、エクセルに取り込んだ画像は、リンク貼り付けになっているのかと考えていますが、取り込んだ画像を埋め込むにはどのようにすればいいでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) Dim myPic Dim myRange As Range '画像を配置するセル範囲 Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target 'このセル範囲に収まるように画像を縮小する 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 = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 End With Application.ScreenUpdating = True Cancel = True End Sub

エクセルのマクロで画像を貼り付け　

画像をエクセルに貼り付ける作業を行っています。マクロを使いファイル内の画像（約３０枚程度）を１列づつスペースを空け右方向に４枚１行スペースを空け３行目の左に戻りその位置よりまた１列づつスペースを空け右方向に４枚・・・・・これを繰り返しファイル内の画像をすべて貼り付けたいのですがうまく動作が出来ません。何卒ご教授の程よろしくお願いします。 ※マクロ Sub EggFunc_pasteDirImage() ' 変数定義 Dim fileName As String Dim targetCol As Integer Dim targetRow As Integer Dim targetCell As Range Dim shell, myPath Dim pos As Integer Dim extention As String Dim isImage As Boolean ' 選択セルを取得 targetCol = ActiveCell.Column targetRow = ActiveCell.Row ' フォルダ選択画面を表示 Set shell = CreateObject("Shell.Application") Set myPath = shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\Users\0602116.MS\Desktop\") Set shell = Nothing ' フォルダを選択したら... If Not myPath Is Nothing Then fileName = Dir(myPath.Items.Item.Path + "\") Do While fileName <> "" ' ファイル拡張子の判別 isImage = True pos = InStrRev(fileName, ".") If pos > 0 Then Select Case LCase(Mid(fileName, pos + 1)) Case "jpeg" Case "jpg" Case "gif" Case Else isImage = False End Select Else isImage = False End If ' 拡張子が画像であれば If isImage = True Then ' 貼り付け先を選択 Cells(targetRow, targetCol).Select Set targetCell = ActiveCell ' 画像読込み ActiveSheet.Pictures.Insert(myPath.Items.Item.Path + "\" + fileName).Select ' 画像が大きい場合、画像サイズをセル幅に合わせる If Selection.Width > targetCell.Width Or Selection.Height > targetCell.Height Then If Selection.Width / targetCell.Width > Selection.Height / targetCell.Height Then Selection.Height = Selection.Height * (targetCell.Width / Selection.Width) Selection.Width = targetCell.Width Else Selection.Width = Selection.Width * (targetCell.Height / Selection.Height) Selection.Height = targetCell.Height End If End If ' 表示位置をセル中央に移動 Selection.Top = targetCell.Top + (targetCell.Height - Selection.Height) / 2 Selection.Left = targetCell.Left + (targetCell.Width - Selection.Width) / 2 ' 貼り付け先行を+1 targetCol = targetCol + 2 End If fileName = Dir() Loop MsgBox "画像の読込みが終了しました" End If End Sub

ドロップダウンリストを設定すると他のマクロがエラーになる

マクロ初心者です（質問も初心者です）下記のマクロを（抜粋）を使用していましたが別のセルにドロップダウンリストを設定すると「実行時エラー’1004’」アプリケーション定義またはオブジェクト定義のエラーです　とでますなぜでしょうか？　対処方法があれば教えてください宜しくお願いします End If '===============画像の掃除 For Each mySP In ActiveSheet.Shapes myAD1 = mySP.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySP.Delete Next

エクセルに写真を挿入するVBA

エクセルで写真集を作るためのVBAですが、以下のVBAでは画像がリンク貼り付けになってしまいます。どうしたらエクセルファイルに画像を貼りこみで保存できるのでしょうか？よろしくお願いいたします。やりたいことは、まずダブルクリックでダイアログボックスを表示させ、挿入したい写真を選択、写真がセルに合わせた大きさに縮小、セルの中央に写真を配置。以上です。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ 　　　　　　　　　　　　　　　　　　　　Cancel As Boolean) 　　Dim PicFile As Variant 　　Dim rX As Double, rY As Double 　　'［ファイルを開く］ダイアログボックスを表示　　PicFile = Application.GetOpenFilename( _ 　　　　　　　　　　　　"画像ファイル,*.jpg;*.jpeg;*.gif;*.tif;*.png;*.bmp") 　　If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub 　　Application.ScreenUpdating = False 　　　　'画像を挿入　　With ActiveSheet.Pictures.Insert(PicFile) 　　　　rX = Target.Width / .Width 　　　　rY = Target.Height / .Height 　　　　If rX > rY Then 　　　　　　.Height = .Height * rY 　　　　Else 　　　　　　.Width = .Width * rX 　　　　End If 　　　　'セルの中央（横方向/縦方向の中央）に配置　　　　.Left = Target.Left + (Target.Width - .Width) / 2 　　　　.Top = Target.Top + (Target.Height - .Height) / 2 　　End With 　　　　Application.ScreenUpdating = True 　　Cancel = True End Sub

Excelの写真貼り付け(90度回転)について

xcelに写真のサイズを自動的に変更するマクロ、(セルの大きさに合わせて）を利用しています。このマクロに対して写真を90度角度を変更して、写真を表示させたいのですが、どのようにすればよいのでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) ActiveSheet.Unprotect Dim C As Range, cm As Range Application.ScreenUpdating = False For Each C In Selection Set cm = C.MergeArea If C.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing Application.ScreenUpdating = True Range("a1").Select End Sub

Excel2010でのマクロによる画像貼付について

エクセル2010で下記のマクロを実行し、一旦保存して再度開くと、「リンクされたイメージを表示できません。ファイルが移動または削除されたか、名前が変更された可能性があります。リンクに正しいファイル名と場所が指定されていることを確認してください。」と表示されます。検索したところ、Pictures.Insertでなく、2010では、Shapes.Addを使用するとの事ですが、マクロに詳しく無いため、どこを修正したらいいのかわかりません。大量の写真貼り付けがあるので、教えて頂けると大変助かります。どうぞよろしくお願いいたします。 Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) '===============起動の合図 If ActiveCell.FormulaR1C1 = "画像" Then Cancel = True '===============画像選択 SSS = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If SSS = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If '===============画像の貼り付け Set CCC = ActiveSheet.Pictures.Insert(SSS) '===============タテヨコの縮尺を保持 HH = Target.Height / CCC.Height WW = Target.Width / CCC.Width If HH > WW Then CCC.Height = CCC.Height * 0.99 CCC.Width = Target.Width * 0.99 Else CCC.Height = Target.Height * 0.99 CCC.Width = CCC.Width * 0.99 End If '===============中央へ調整 HH2 = (Target.Height / 2) - (CCC.Height / 2) WW2 = (Target.Width / 2) - (CCC.Width / 2) CCC.Top = Target.Top + HH2 CCC.Left = Target.Left + WW2 Set CCC = Nothing End If End Sub

エクセルVisualBasicマクロ詳しい方

写真を特定のセルに貼り付けるのにダブルクリックでマイドキュメントがでるようにし、写真を貼り付けるとサイズを枠に調節するようにマクロをつくりました。問題なく出来るようになったのですが、ダブルクリックでマイドキュメントではなく、別の場所を指定するにはどこをどう変えればいいですか？現状は以下の通りです。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Union(Range("A1:A21"))) Is Nothing Then Exit Sub Cancel = True Dim myPic Dim myRange As Range '画像を配置するセル範囲 Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target 'このセル範囲に収まるように画像を縮小する 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 = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 End With Application.ScreenUpdating = True Cancel = True End Sub

エクセル2007のマクロについて

B9に品番を入力するとA9に画像が自動挿入される所まではなんとか出来たのですが、同じくB10,B11,B12・・・と下の行にも同じように品番を入力すれば画像が自動挿入される様にするには,どうのようにすれば良いのでしょうか？宜しくお願い致します。　 A 　 B 9 画像品番 10 画像品番 11 画像品番 12 画像品番　　　・　　　・　　　・ Private Sub Worksheet_Change(ByVal Target As Range) Const ImagePath = "C:\Users\f\Desktop\画像\" If Intersect(Target, Range("B9")) Is Nothing Then Exit Sub Application.EnableEvents = False Dim codRange As Range Set codeRange = Range("B9") Dim picRange As Range Set picRange = Range("A9") Dim objPic As Picture For Each objPic In ActiveSheet.Pictures If objPic.Left >= picRange.Left And objPic.Left <= picRange.Left + picRange.Width _ And objPic.Top >= picRange.Top And objPic.Top <= picRange.Top + picRange.Height Then objPic.Delete Exit For End If Next picPath = ImagePath & codeRange.Value & ".jpg" If Dir(picPath, vbNormal) = "" Then picRange.Cells(1, 1).Value = "画像がありません" Else picRange.Select Sheets(1).Pictures.Insert(picPath).Select '画像ファイルの挿入 With ActiveSheet.Pictures(ActiveSheet.Pictures.Count).ShapeRange .LockAspectRatio = msoFalse .Parent.Visible = msoTrue .Left = picRange.Left .Top = picRange.Top .Height = picRange.Height .Width = picRange.Width End With picRange.Cells(1, 1).Value = "" End If Application.EnableEvents = True End Sub

Excel写真帳の写真を挿入マクロを教えて下さい。

Excelで工事写真帳での写真枠のダブルクリックで写真挿入のマクロを教えて下さい。使用パソコン第１パソコン・Windows7・Excel2013 第２パソコン・WindowsXp・Excel2003 現在Excel2013をメインに使用しています。今までExcel2003でExcelでの工事写真帳と資料用の写真帳をマクロで写真挿入枠をセルの結合で作成して、ダブルクリックで写真データ保存のフォルダを開いて写真の挿入をしていました。 Excel2013で使用するとデータ（工事写真帳と資料用の写真帳）を別のパソコンへ移動したりデータを第三者への提出したり、写真データの移動／削除すると下記のような状態（コメント）になります。リンクされたイメージを表示出来ません。ファイルが移動または削除されたか、名前が変更された可能性があります。リンクに正しいファイル名と場所が指定されていることを確認して下さい。状況は、たぶんリンク貼り付けになってしまう仕様に新Excelはなっている。 Excel 2010 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると図がリンクオブジェクトとして挿入される http://support.microsoft.com/kb/2396509/ja だと思っててます。リンク回避もしくはマクロをどの様に変更したら良いのでしょうか。使用しているマクロは下記です。（Excel2003で使用していたマクロ）よろしくご教授をお願いします。。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim fname As String Dim pos As Integer If Target.Column <> 2 Then Exit Sub If Target.Cells.count = 1 Then Exit Sub Cancel = True fname = Application.GetOpenFilename() If fname = "False" Then Exit Sub pos = InStrRev(fname, ".") If pos > 0 Then Select Case LCase(Mid(fname, pos + 1)) Case "jpeg" Case "jpg" Case "gif" Case Else Exit Sub End Select Else Exit Sub End If With ActiveSheet.Pictures.Insert(fname) .ShapeRange.LockAspectRatio = msoTrue .Height = Target.Height If .Width > Target.Width Then .Width = Target.Width End If .Top = Target.Top + (Target.Height - .Height) / 2 .Left = Target.Left + (Target.Width - .Width) / 2 End With End Sub

エクセルのマクロで、複数の写真をセルの中央に

エクセルのマクロにて下記のようなことをしたいと思っています。ご教授お願いします。なお、以前に出ていた回答をベースにしたいと考えています。そのコードも下記に載せておきます。やりたいこと (1).複数の写真がある (2).1枚目の写真はB1に貼り付けている (3).同様にn枚目の写真はBnに貼り付けている（今現在300枚、今後増える予定）ここまではもうやっています。この後が問題なのですが (4).Bnのセルの中で、写真をセルの中央に移動させたいこの(4)ができず困っています。既出で参考にした回答は下記です。下記に手を加えていただき、(4)ができるようにしていただければ助かるのですが。よろしくお願いいたします。 http://okwave.jp/qa/q3875596.html 参考にしたコード Sub picCenter() Dim p As Object Dim rng, trg As Range Const adr As String = "A26"　'処理対象セルの左上のアドレス　　If Range(adr).MergeCells Then 　　　　Set rng = Range(adr).MergeArea 　　Else 　　　　Set rng = Range(adr) 　　End If 　　For Each p In ActiveSheet.Pictures 　　　　Set trg = Intersect(rng, p.TopLeftCell) 　　　　If Not trg Is Nothing Then 　　　　　　If p.Width < rng.Width Then 　　　　　　　　p.Left = rng.Left + (rng.Width - p.Width) / 2 　　　　　　End If 　　　　　　If p.Height < rng.Height Then 　　　　　　　　p.Top = rng.Top + (rng.Height - p.Height) / 2 　　　　　　End If 　　　　End If 　　Next p End Sub この中の Const adr As String = "A26"　'処理対象セルの左上のアドレスという箇所を、for-next関数でたとえばi=1からi=500としセル番地Biで実行したらいいと思うのですが。

Excelマクロでセルをダブルクリックすると画像が選べるようにする方法

エクセル　写真貼り付け　マクロ

質問者が選んだベストアンサー

お礼 2016/09/30 10:04

その他の回答 (2)

補足 2016/09/30 09:33

関連するQ&A

マクロで画像挿入の質問です

【急】Excelで写真張り付けマクロを書き換えたい

VBAの修正コードを教えてください（初心者）

教えてください。

VBAの写真貼り付けコードについて教えてください。

VBAの操作方法について教えてください（初心者）

excel　マクロ　画像挿入

エクセル　マクロ

エクセル２０１０　挿入画像の圧縮　VBA

VBAの内容の修正をお願いさせて頂きます

エクセル貼付けの画像がメール添付で表示されません

エクセルのマクロで画像を貼り付け

ドロップダウンリストを設定すると他のマクロがエラーになる

エクセルに写真を挿入するVBA

Excelの写真貼り付け(90度回転)について

Excel2010でのマクロによる画像貼付について

エクセルVisualBasicマクロ詳しい方

エクセル2007のマクロについて

Excel写真帳の写真を挿入マクロを教えて下さい。

エクセルのマクロで、複数の写真をセルの中央に

注目のQ&A

カテゴリ
一覧

専門家に質問してみよう
専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

Excelマクロでセルをダブルクリックすると画像が選べるようにする方法

エクセル 写真貼り付け マクロ

質問者が選んだベストアンサー

お礼 2016/09/30 10:04

その他の回答 (2)

補足 2016/09/30 09:33

関連するQ&A

マクロで画像挿入の質問です

【急】Excelで写真張り付けマクロを書き換えたい

VBAの修正コードを教えてください（初心者）

教えてください。

VBAの写真貼り付けコードについて教えてください。

VBAの操作方法について教えてください（初心者）

excel マクロ 画像挿入

エクセル マクロ

エクセル２０１０ 挿入画像の圧縮 VBA

VBAの内容の修正をお願いさせて頂きます

エクセル貼付けの画像がメール添付で表示されません

エクセルのマクロで画像を貼り付け

ドロップダウンリストを設定すると他のマクロがエラーになる

エクセルに写真を挿入するVBA

Excelの写真貼り付け(90度回転)について

Excel2010でのマクロによる画像貼付について

エクセルVisualBasicマクロ詳しい方

エクセル2007のマクロについて

Excel写真帳の写真を挿入マクロを教えて下さい。

エクセルのマクロで、複数の写真をセルの中央に

注目のQ&A

カテゴリ 一覧

専門家に質問してみよう 専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

エクセル　写真貼り付け　マクロ

excel　マクロ　画像挿入

エクセル　マクロ

エクセル２０１０　挿入画像の圧縮　VBA

エクセルのマクロで画像を貼り付け　

カテゴリ
一覧

専門家に質問してみよう
専門家登録