[[20141105093346]]　『画像をワード経由（ドラッグ＆ドロップ）で効率よ』（sasa）　ページの最後に飛ぶ

『画像をワード経由（ドラッグ＆ドロップ）で効率よく貼り付けたい』（sasa）

大量の画像を以下のマクロ（以前作成してもらいました）を
使用して貼り付けているのですが、画像のあるフォルダが大量にあるため、
毎回フォルダを参照するよりも、ドラッグ＆ドロップで、
word2007にドラッグしてからExcelにドラッグして貼り付けています。

そこで問題なのが、Excelのシートに枠線がたくさんあり最初に画像を置いた位置に
枠線が消えてしまうので、元のExcelの写真を挿入しているセル（結合されているマクロボタン）に
置きたいのですが、「クリップボードに保存されているデータの大きさや形が、
指定された領域と異なります。貼り付けますか？」というエラーで貼り付けられないのと、
マクロを無効にしても結合されているため直接貼り付けられないのですが、
どのようにすればうまくいくでしょうか。

使っているマクロは以下になります。

 Sub pasteImage()
    Dim filter
    Dim file

    Application.ScreenUpdating = False

    filter = "画像 ファイル (*.jpg),*.jpg,画像 ファイル (*.bmp),*.bmp"
    file = Application.GetOpenFilename(filter, , , , False)

    If Not file = False Then
        ActiveSheet.Shapes.AddPicture _
            Filename:=file, _
            LinkToFile:=False, _
            SaveWithDocument:=True, _
            Left:=Selection.Left + 1.25, _
            Top:=Selection.Top + 1.25, _
            Width:=370.5, _
            Height:=278.25
    End If

    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

よろしくお願いします。

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

Wordを経由するというのは無駄ですね。また、いちいちファイル1つずつ指定するのも面倒です。別案を考えるべき。

例えば、マクロ入りブックのあるフォルダ直下にinputフォルダを作成し、ここに貼りたい画像のコピーを置きます。
そのあと、マクロ実行で一気に貼り付けるのが良いでしょう。

ここで問題になるのが、どの画像をどのセルに貼り付ければ良いのか判らない点です。これを決定してください。
（上の案ほど、マクロ作成が容易ですが、別案があればそれを書いてください）

案１：とりあえず全部の画像を重ならないようにシートに貼り付けるだけ。セルへは手作業で移動する。
案２：コピーした画像ファイル名をリネームし、貼りたいセル位置に変えておく。（A1.jpg、等）
案３：画像を貼りたいシートとは別のシートに、画像ファイル名と貼りたいセル位置を記入した表を用意。これを参照する。
（???） 2014/11/05(水) 11:14

案４：画像挿入したいセルを右クリックすると、ユーザーフォーム表示。
ここに画像ファイル名を列挙しておき、画像ファイル名をダブルクリックすると1画像貼り付け。
（inputフォルダに全画像をまとめておくのは上記と同様です）

【ThisWorkbook】

 Private Sub Workbook_Open()
    Dim cFile As String
    Dim cPath As String

    cPath = ActiveWorkbook.Path & "\input\"
    With UserForm1
        .Hide
        cFile = Dir(cPath & "*.*")
        While cFile <> ""
            .ListBox1.AddItem cFile
            cFile = Dir
        Wend
    End With
 End Sub

【シートモジュール】

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    UserForm1.Show vbModeless
    Cancel = True
 End Sub

【UserForm1】（ユーザーフォームを追加し、ここにListBoxコントロールとImageコントロールを貼っておく）

 Private Sub ListBox1_Click()
    Image1.Picture = LoadPicture(ActiveWorkbook.Path & "\input\" & ListBox1.Text)
 End Sub

 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveSheet.Shapes.AddPicture _
        Filename:=ActiveWorkbook.Path & "\input\" & ListBox1.Text, _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=Selection.Left + 1.25, _
        Top:=Selection.Top + 1.25, _
        Width:=370.5, _
        Height:=278.25
    ListBox1.RemoveItem ListBox1.ListIndex
 End Sub
（???） 2014/11/05(水) 12:00

返答遅くなりすみません。。
ちょっとわたしの知識ではまだ扱いが難しいのと、
写真を張り付ける量が数百程で、1bookに20シート位もあり（元請けシート）写真の種類の多様というのもあり、
規則性をもつのが難しそうなので、案1のようにシンプルなマクロがあればお願いできないでしょうか。。

手順としては、今までは
フォルダのエクスプローラーのプレビューで特大アイコンにしてから（選びながら）、
ドラッグドロップ（ワード経由）で、Excelへ一個ずつ移動していました。

※Excelは、1シートごとに縦に3枚貼るようになっており、1個の枠は固定で、
結合セル（ Width:=370.5, Height:=278.25）でしょうか。。

その枠にドラッグした際、その大きさ、幅にに自動で貼りつくようにしたいです。
伸縮率はある程度変形してもかまいません。

よろしくお願いします。。

（sasa） 2014/11/07(金) 17:00

1つずつ処理する面倒さは変わりませんが、
↓のWebBrowserを使う方法と現在のマクロを組み合わせるのはどうですか。

http://oshiete.goo.ne.jp/qa/7167712.html

（マナ） 2014/11/08(土) 10:12

画像をシートに全部並べて貼るだけのシンプル案。

 Sub test()
    Dim cFile As String
    Dim cPath As String
    Dim iR As Single

    cPath = ActiveWorkbook.Path & "\input\"
    cFile = Dir(cPath & "*.*")
    While cFile <> ""
        ActiveSheet.Shapes.AddPicture _
            Filename:=cPath & cFile, _
            LinkToFile:=False, _
            SaveWithDocument:=True, _
            Left:=0, _
            Top:=iR, _
            Width:=370.5, _
            Height:=278.25
            iR = iR + 278.25
        cFile = Dir
    Wend
End Sub
（???） 2014/11/10(月) 09:24

返信おそくなりすみません。。
上記のマクロを入れ替えてみましたが、以下のエラーがでて使用できません。。

コンパイルエラー　：Sub または Function が定義されていません　と出て使用できません。。
スペルなどが間違っているかもみてみましたが、よくわかりませんでした。

ブラウザのリストビュー？を使用した方法が便利そうですが、いろいろ設定などが
ありそうなので、後で調べながらやってみようと思います。
ありがとうございます！
（sasa） 2014/11/11(火) 13:05

ファイル数分ループさせただけで、元のマクロと大差ないのですが…。

案４と違い、案１ならばシートモジュール1つにマクロを貼るだけです。
マクロを入れ替えるのではなく、新しいブックにマクロを貼って、ファイル保存してから実行してみてください。
（???） 2014/11/11(火) 13:30

コメント返信：

[ 一覧(最新更新順) ]

[[20141105093346]] 『画像をワード経由（ドラッグ＆ドロップ）で効率よ』（sasa） ページの最後に飛ぶ

[[20141105093346]]　『画像をワード経由（ドラッグ＆ドロップ）で効率よ』（sasa）　ページの最後に飛ぶ