中小企業の働き方改革をサポート>>

Excel2010にて、 VBA マクロ 画像(図)貼り付けを行いたいと思っています。
しかし、マクロを自動登録すると、ActiveSheet.Pictures.Paste.Selectになり、AddPicture ができません。 下記のマクロをAddPictureへ変換したいのですが、そのまま、InsertをAddpictureに変更してもエラーになってしまいます。 いい方法を教えてください(ToT)/~~~。 どうぞよろしくお願いします。

Sub Test()
'
' Test Macro
'
Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.RowHeight = 150#

Range("C4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileC.gif"").Select
ActiveSheet.Pictures.Paste.Select
Range("D4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileD.gif"").Select
Selection.Cut
Range("D4").Select
ActiveSheet.Pictures.Paste.Select
Range("E4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileE.gif"").Select
Range("E4").Select
ActiveSheet.Pictures.Paste.Select
Range("F4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileE.gif"").Select
ActiveSheet.Pictures.Paste.Select
Range("G4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileG.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("H4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileH.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("I3").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileI.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("J4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileJ.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("K3").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileK.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("L3").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileL.gif"").Select
ActiveSheet.Pictures.Paste.Select
Range("M4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileM.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("N4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileN.gif").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
End Sub

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

A 回答 (2件)

ファイル名が fileC.gif~fileN なら


Sub Test()
  Dim c As Range
  Dim myPath As String
  Dim FileName As String

  Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Selection.RowHeight = 150#
  myPath = "E:\FolderA\"
  For Each c In Range("C4:N4")
    FileName = "file" & Left(c.Address(0, 0), 1) & ".gif"
    With ActiveSheet.Shapes.AddPicture( _
      FileName:=myPath & FileName, _
      LinkToFile:=True, _
      SaveWithDocument:=False, _
      Left:=0, Top:=0, Width:=0, Height:=0)
      .ScaleHeight 1!, True
      .ScaleWidth 1!, True
      .LockAspectRatio = True
      .Locked = False
      .Left = c.Left
      .Top = c.Top
    End With
  Next
End Sub
    • good
    • 0

このようにします。


Range("C4").Select
ActiveSheet.Shapes.AddPicture "E:\FolderA\fileC.gif", False, True, Range("C4").Left, Range("C4").Top, 200, 150

ActiveSheet.Pictures.Paste.Select
    • good
    • 0

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

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

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

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

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

QエクセルVBAで画像を貼り付ける座標設定方法は?

Sheets("Sheet1")に貼り付けたJ-pegの画像(=シンボルマーク)を別なシートに貼り付けるのは下記のVBAで出来ました。ただ、これでは貼り付け先のシートのセルK12が、貼り付け元のK12と同じ位置でないと思った場所に張り付きません。
そこでセルで場所を指定するのではなく、座標のようなもので指定する方法はないものかと考えた次第です。
オートシェイプなどは座標指定で作成できるのですが、J-pegのような画像はどうすればいいのでしょうか?

Sub TEST()
Sheets("FACE").Shapes("シンボルマーク").Copy
ActiveSheet.Range("K12").Select
ActiveSheet.Paste
End Sub

Aベストアンサー

#1です。
>この場合、ファイルをエクセルにくっつけて渡すなんてこと
>はできないものでしょうか?(別々にではなくあくまでエク
>セルのブックに付属した形で)
Excelのブックに付属した形にするなら、コピーペーストする方がいいと思います。一旦挿入した画像を別途保存するのは、簡単には出来ないと思います。

複数のシートで同じような作業をするなら、次のような方法も考えられます。
Function CpyMrk(MrkNM As String, myTop As Single, myLeft As Single)
Sheets("FACE").Shapes(MrkNM).Copy
ActiveSheet.Paste
ActiveSheet.Shapes(MrkNM).Top = myTop
ActiveSheet.Shapes(MrkNM).Left = myLeft
End Function

Sub test()
CpyMrk "シンボルマーク", 10, 10
End Sub

QエクセルVBA 図形の選択法は?

セル範囲をコピー
図としてペースト
ペーストされた図形を選択

記録マクロで書くと下記のようになります。
Sub Macro1()
Range("G2:K15").Select
Selection.Copy
Range("A1").Select
ActiveSheet.Pictures.Paste.Select
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
End Sub

・場所を指定してペーストするのは、事前にselectする必要あるのでしょうか?
・挿入された図の名前がPicture1と分ってないと選択出来ません。他に方法あるのでしょうか?
図は複数あり、たった今ペーストした図形を選択したいのです。

参考になるURLあるいは書籍はないでしょうか?

Aベストアンサー

>挿入された図の名前がPicture1と分ってないと選択出来ません。他に方法あるのでしょうか?

Pasteする際に、Excelが勝手につけた名前を変数に保存して、その名前でSelectすることができます。

名前の保存は、こんな感じで。
MyPicName = ActiveSheet.Pictures.Paste.Name  ’Pasteと同時に、その名前を変数に代入します。

QVBAマクロで、図形等のオブジェクトを選択(特定)する方法ってありますか

こんにちは。VBAマクロを少しかじっています。
顔写真付きの従業員の検索システムを作りました。名前を入力(選択)したら、データシートから職員コード、住所、電話番号などの情報を検索し検索画面に表示します。この際、別のシートに顔写真を貼り付けたもの(1セルに1枚。セルに従業員名を入力してある。)から、VLOOKUP関数を使ってセル照会することで、画像も同時に表示することができます。
別の職員に切り換えたり、クリアする場合の画像の処理は、削除用のシートを用意し、そこにセルごと移動し、終了時にシートごと削除する方法をとりました。(当然、確認用のダイアログボックスが表示されます。)
前置きが長くなりましたが、問題は、用済みの画像を選択するプロシージャがあれば、あえて削除用のシートを用意する必要はありません。セルの場合は、Rangeプロパティやcellsプロパティで特定できますが、画像などのオブジェクトをセル番地などを使って特定する方法ってあるのでしょうか。
因みに、画像の選択処理を、マクロ記録でプロシージャを作成したら、
ActiveSheet.Shapes("Picture 1").Select などとなります。
よろしくお願いします。

こんにちは。VBAマクロを少しかじっています。
顔写真付きの従業員の検索システムを作りました。名前を入力(選択)したら、データシートから職員コード、住所、電話番号などの情報を検索し検索画面に表示します。この際、別のシートに顔写真を貼り付けたもの(1セルに1枚。セルに従業員名を入力してある。)から、VLOOKUP関数を使ってセル照会することで、画像も同時に表示することができます。
別の職員に切り換えたり、クリアする場合の画像の処理は、削除用のシートを用意し、そこにセルごと移動し、終了時...続きを読む

Aベストアンサー

検索シートにシェイプが1つしかなければ
ActiveSheet.Shapes(1).Select
で選択
ActiveSheet.Shapes(1).Delete
で削除できます。

QエクセルVBAでクリップボード内容をクリア

こんにちは。
エクセルのVBAの処理の中で、ある部分をコピーしてそれを、
貼り付けする処理をしています。
処理終了後、ファイルを閉じるときに、クリップボードに
コピーの内容が残っている旨のメッセージがでてきます。
このメッセージを出さない様に、クリップボードの内容を
クリアするにはどのようにすればよろしいでしょうか?
申し訳ありませんが、お教え頂きますようお願いいたします。

Aベストアンサー

Excel.Application.CutCopyMode = False
Workbooks(fName).Close savechanges:=False

かな。1行目だけでいいかも。

QExcelのVBAで画像読込→サイズ変更がしたい。

Excel2003を利用して仕事の工事写真帳を作成していますがVBAでどうしても上手くいかない部分があるので教えていただければと思い投稿しました。
【仕様】工事写真帳は1シート構成、用紙1枚に3枚画像が入り、画像の右側には摘要欄があります。画像を読み込む位置をダブルクリックするとセルのサイズ(写真サイズに結合してあります)を取得して画像サイズを変更して格納します。
【問題点】2枚以上画像を読み込んだ状態で実行すると目的の画像のサイズが変更にならない場合があります。
画像を削除したことで画像の名前が重複するのが原因だというところまではわかるのですが対処方法がわかりません。アドバイスをお願いします。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

gyo = ActiveCell.Row '画像読込位置の取得
Set scel = Cells(gyo, 3)

scel.Select 'セルサイズの取得
w = Selection.Width
h = Selection.Height

fname = Application.GetOpenFilename _
("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像ファイルを指定して下さい") '画像読込
If fname = False Then
Exit Sub
End If
ActiveSheet.Pictures.Insert(fname).Select
i% = Selection.Index


Selection.Name = "gazou" & i '画像に名前をつける
Set 画像 = ActiveSheet.Shapes("gazou" & i)


With 画像 '画像のサイズ変更
.LockAspectRatio = False
.Placement = xlFreeFloating
.Placement = xlMove
.Width = w
.Height = h
End With

Range("F" & gyo).Select '摘要欄へ移動

End Sub

Excel2003を利用して仕事の工事写真帳を作成していますがVBAでどうしても上手くいかない部分があるので教えていただければと思い投稿しました。
【仕様】工事写真帳は1シート構成、用紙1枚に3枚画像が入り、画像の右側には摘要欄があります。画像を読み込む位置をダブルクリックするとセルのサイズ(写真サイズに結合してあります)を取得して画像サイズを変更して格納します。
【問題点】2枚以上画像を読み込んだ状態で実行すると目的の画像のサイズが変更にならない場合があります。
画像を削除したことで画...続きを読む

Aベストアンサー

画像にわざわざ名前をつける必要はあるのでしょうか?
(以下は一部抜粋して、少しだけ手を入れました)

Dim pict As String
 ActiveSheet.Pictures.Insert(fname).Select
 pict = Selection.Name
 With ActiveSheet.Shapes(pict) '画像のサイズ変更
  .LockAspectRatio = False
  .Placement = xlFreeFloating
  .Placement = xlMove
  .Width = w
  .Height = h
 End With

これなら画像を繰り返し削除しても大丈夫に思います

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Qエクセルvbaでの図形のカット(コピー)ペーストについて

エクセル2013のVBAで図形をカットして、別の位置に貼り付けるのに、下記のコードで動作させて一応問題なく動作しています。

Sub sample()
ActiveSheet.Shapes("角丸四角形 10").Cut
Cells(1, 1).Select
ActiveSheet.Paste

End Sub

これを、もう少し修正して

ActiveSheet.Shapes("角丸四角形 10").Cut
ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme

このように書くと、
実行時エラー1004
RangeクラスのPasteSpecialメソッドが失敗しました

となり、

ActiveSheet.Shapes("角丸四角形 10").Cut Destination:=ActiveSheet.Range("A1")

このように書くと、
実行時エラー1004
アプリケーション定義またはオブジェクト定義のエラーです

となってしまいました。
図形の貼り付けは一度貼り付け場所をselectしないと貼り付けられないのでしょうか?
またはどのように書けばよいのでしょうか?

エクセル2013のVBAで図形をカットして、別の位置に貼り付けるのに、下記のコードで動作させて一応問題なく動作しています。

Sub sample()
ActiveSheet.Shapes("角丸四角形 10").Cut
Cells(1, 1).Select
ActiveSheet.Paste

End Sub

これを、もう少し修正して

ActiveSheet.Shapes("角丸四角形 10").Cut
ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme

このように書くと、
実行時エラー1004
RangeクラスのPasteSpecialメソッドが失敗しました

となり、

A...続きを読む

Aベストアンサー

こんなんでいかがでしょう。

ActiveSheet.Shapes("角丸四角形 10").Cut
ActiveSheet.Paste Destination:=Range("A1")

ちなみに、"角丸四角形 10" は切り取られて、無くなってしまいます。
ペーストされたものには、別の名前が付きます。

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 = 480#
Selection.ShapeRange.Rotation = 0#
End Sub

これだと、写真が指定されてしまいます。
マクロの途中で止まって任意の写真を都度選べるようにできますか?
膨大な量の写真をセルに並べていきたいのです。

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

(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エクセル マクロ実行時エラー’1004’

For~Next構文内でシートコピーしていると途中で、
実行時エラー'1004’
WorksheetクラスのCopyメソッドが失敗しました。
が表示されることがあります。

該当のFor~Next文は10回以上実行されているので、コードの誤りではないと思うのですが、なぜ「Copyメソッドが失敗」するのかわかりません。
理由/対処方法がわかればありがたいと思い質問させていただきます。

**該当コード**
Sub 評価シート作成()
  Sheets(社員一覧).Select
  行 = 1
  Do
    ReDim Preserve 社員CD(行)
    ReDim Preserve 氏名(行)
    社員CD(行) = Cells(行 + 1, 1).Value
    氏名(行) = Cells(行 + 1, 2).Value
    行 = 行 + 1
  Loop Until Cells(行, 1) = ""
  人数 = 行 - 2
  For 回数 = 1 To 人数
    Sheets(評価シート).Select
    Sheets(評価シート).Copy after:=Sheets(評価シート)
    ActiveSheet.Name = 氏名(回数)
    Cells(4, 5) = 氏名(回数)
    Cells(4, 3) = 社員CD(回数)
  Next 回数
End Sub
*****************************
よろしくお願いします

For~Next構文内でシートコピーしていると途中で、
実行時エラー'1004’
WorksheetクラスのCopyメソッドが失敗しました。
が表示されることがあります。

該当のFor~Next文は10回以上実行されているので、コードの誤りではないと思うのですが、なぜ「Copyメソッドが失敗」するのかわかりません。
理由/対処方法がわかればありがたいと思い質問させていただきます。

**該当コード**
Sub 評価シート作成()
  Sheets(社員一覧).Select
  行 = 1
  Do
    ReDim Preserve 社員CD(行)
   ...続きを読む

Aベストアンサー

ひょっとしてこれに該当するのかな?

Excel でプログラムを使用してワークシートをコピーするとランタイム エラー 1004 が発生する
http://support.microsoft.com/kb/210684/ja

QVBAエクセルに貼り付けた画像をセルにあった大きさにしたい(等倍)

エクセル貼り付けた画像をセルにあった大きさにしたいのですが、
その際、縦と横の比率を変更したくありません。

縦と横の比率を変更せず、セルにおさまる最大の大きさで画像のサイズを
変えることは可能でしょうか。

-----------------------------------------------------------------------------
縦と横の比率が関係なく、セルいっぱいのサイズに画像の大きさを変更するVBAは
下記URLから見つけられたのですが、、、、、
http://q.hatena.ne.jp/1240648036

Aベストアンサー

No.1です。

>画像が置いてあるセル上で処理を行う

画像のどこを基準にするか?によってコードは変わってきますが、
画像の左上端のセルにその画像を縦・もしくは横いっぱいに配置するコードにしてみました。

Sub Sample2()
Dim mySp As Shape, myRng As Range
Dim myHgt As Double, myWdt As Double

For Each mySp In ActiveSheet.Shapes
With mySp
Set myRng = .TopLeftCell
myHgt = myRng.Height
myWdt = myRng.Width
.Top = myRng.Top
.Left = myRng.Left
.Height = myHgt
If .Width > myWdt Then
.Width = myWdt
End If
End With
Next mySp
End Sub

こんな感じではどうでしょうか?m(_ _)m

No.1です。

>画像が置いてあるセル上で処理を行う

画像のどこを基準にするか?によってコードは変わってきますが、
画像の左上端のセルにその画像を縦・もしくは横いっぱいに配置するコードにしてみました。

Sub Sample2()
Dim mySp As Shape, myRng As Range
Dim myHgt As Double, myWdt As Double

For Each mySp In ActiveSheet.Shapes
With mySp
Set myRng = .TopLeftCell
myHgt = myRng.Height
myWdt = myRng.Width
.Top = myRn...続きを読む


人気Q&Aランキング

おすすめ情報