[[20080623180744]] 『自動画像表示』(saru) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『自動画像表示』(saru)Excel2003 Windows XP
 どうすればいいかわからなくなり質問させていただきます。

 やりたい事は、以下の通りです。

 @あるシート(sheet1)の列(A)に画像ファイルを入力しエンターキーを押すたびに、
  自動で、決まったフォルダー(例 D:\data\)に入っている
  jpg又は、ビットマップ、GIFファイルを、
  列(B)に挿入し、画像をセルの大きさに自動調整をして、
  セルと画像をグループ化したいのですが、出来ますでしょうか?

 A別シート(sheet2)に、シート(sheet1)の結果から編集作業をしたいので、
  @を実行した場合、自動で同じ画像ファイル名の所に自動でシート(sheet1)の
  画像を貼り付けたいのですが可能でしょうか?
  *シート(sheet1)と、シート(sheet2)のセルの位置は違います。

 以上よろしくお願いいたします。

もし無理なら@のみでもいいので出来ますでしょうか?
(saru)

 指定画像挿入の過去ログです。
[[20080209021147]]『画像の貼り付け』(VBA初心者)

 (HANA)

 (HANA)様ありがとうございます。
 説明不足でした、やってみましたが、決まったところにしか画像が出来ません。
 表は以下の通りになっています。
   A       B         C      D          E
1 商品名	ファイル名	リンク場所	画像	       8
2 101004	101004_bl_o	D:\data\	   D:\data\101004_bl_o	
3 101009	101009_bl_a	D:\data\	   D:\data\101009_bl_a	
4 101010	101010_bl_a	D:\data\    D:\data\101010_bl_a	
5 101011	101011_bl_o	D:\data\    D:\data\101011_bl_o	

 E1には、=COUNT(A:A)が入力しています。
 Dには、=CONCATENATE(C*,B*)が入力しています。*は、行番号が入ります。
 画像を表示したいところは、E列です。現在は、E2にしか画像が出ない状態です。
 今後したいことは以下の通りです。
@ A列又は、B列で入力後エンターを押すとその行のE列に画像を挿入したいです。
 (他の列の時は、動作しない方が、うれしいです。無理であれば、入力した列の対応でもいいです。)

A マクロを実行した場合、入力行の画像のみ削除をして、新たに画像を挿入したいです。
 (今のままだと、画像が重なっていくので・・・・・)

B マクロで、入力されている物を全部画像の入替をしたいです。

現在マクロは以下の通りになっています。

 −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim org As Range
    Set org = Range("E2")
    On Error Resume Next
    With ActiveSheet.Pictures.Insert(Range("D2").Value & ".jpg")
            If Err.Number <> 0 Then
                MsgBox "画像挿入は出来ませんでした。"
            Else '画像修正
                .Left = org.Left
                .Top = org.Top
                .Width = org.Width
                .Height = org.Height
            End If
        End With
        On Error GoTo 0
End Sub

−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−

 (saru)

 当初の二番目の御質問を含めて、こんな感じの事ですか?

 '------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim org1 As Range, org2 As Range, kst As String, tr As String

    With Target
        If .Column > 2 Then Exit Sub
        tr = .Row
        kst = Range("B" & .Row)
        Set org1 = Range("E" & tr)

        On Error Resume Next
        Me.Shapes("$E$" & tr).Delete
        Sheets("Sheet2").Shapes("$E$" & tr).Delete
        On Error GoTo 0

        On Error Resume Next
        With ActiveSheet.Pictures.Insert(Range("D" & .Row).Value & ".jpg")
            If Err.Number <> 0 Then
                MsgBox "画像挿入は出来ませんでした。"
                Exit Sub
            End If
            .Name = org1.Address
            .Left = org1.Left
            .Top = org1.Top
            .Width = org1.Width
            .Height = org1.Height
        End With
        On Error GoTo 0
    End With

    With Sheets("Sheet2")
        Set org2 = .Cells.Find(What:=kst, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, MatchByte:=False, SearchFormat:=False)
        If org2 Is Nothing Then
            MsgBox "Sheet2にファイル名が有りません。"
            Exit Sub
        End If

        Me.Shapes("$E$" & tr).Copy
        .Paste

        With .Shapes("$E$" & tr)
            .Left = org2.Left
            .Top = org2.Top
            .Width = org2.Width
            .Height = org2.Height
        End With
    End With
End Sub
 '------

 ちなみに、今回の3番目の御質問は良く分かりません。
 チェンジイベントとは別の
 一括で挿入をするマクロが必要 と言う事?

 (HANA)

 (HANA)様ありがとうございます。
 今回の@Aは、思い通り動きました。

 今回のBは、チェンジイベントとは別の一括でSheet1、Sheet2の画像を、
 削除、新規で貼付けをするマクロが必要と言う事です。
 説明が悪くすみません。

 >当初の二番目の御質問を含めて、こんな感じの事ですか?
 と前回分を考慮いただきましたが、MsgBox "Sheet2にファイル名が有りません。"
 と表示されます。
 *Sheet2は、Sheet1と同じフォーマットにしても、同じになります。

 お忙しいとは思いますが、
 以上よろしくお願いいたします。

 (saru)


 新しいブックをひらき
 Sheet2のどこかのセルに「1」を入力

 Sheet1のシートモジュールに
 ↓を貼り付け。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim org2 As Range, kst As String, tr As String
    With Target
        If .Column > 2 Then Exit Sub
        tr = .Row
        kst = Range("B" & .Row)
    End With    
    With Sheets("Sheet2")
    Set org2 = .Cells.Find(What:=kst, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, MatchByte:=False, SearchFormat:=False)
    If org2 Is Nothing Then
        MsgBox "Sheet2にファイル名が有りません。"
        Exit Sub
    Else
        MsgBox org2.Address & " に有りました。"
    End If
    End With
End Sub

 Sheet1のB1セルに「1」を入力。

 やはり「有りません」と出ますか?

 (HANA)

 (HANA)様ありがとうございます。

 今度は、コンパイルエラー
 名前が適切ではありません:worksheet_change
と出ます。

 (saru) 

 【新しいブック】で上記方法
 1.Sheet2のどこかのセルに「1」を入力
 2.Sheet1のシートモジュールに↓を貼り付け。
 3.Sheet1のB1セルに「1」を入力。

を試して頂けていますか?

 Worksheet_Changeイベントが二つあるように思いますが・・・。

 (HANA)

 (HANA)様ありがとうございます。

 動いたのですが、思いと違いました、
 説明不足ですみません。

 すみませんでした。
 以前うまくいった、事と一緒にしたかったので、
 以下のようにご回答いただきました、ものに追加していました。

 >当初の二番目の御質問を含めて、こんな感じの事ですか?
 −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−− 
 @ A列又は、B列で入力後エンターを押すとその行のE列に画像を挿入したいです。
  (他の列の時は、動作しない方が、うれしいです。無理であれば、入力した列の対応でもいいです。)
 A マクロを実行した場合、入力行の画像のみ削除をして、新たに画像を挿入したいです。
  (今のままだと、画像が重なっていくので・・・・・) 
 −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−− 
 この時に動いていた物はそのまま使用しまして、(以下の内容に追加していました。)
 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim org1 As Range, org2 As Range, kst As String, tr As String
    With Target
        If .Column > 2 Then Exit Sub
        tr = .Row
        kst = Range("B" & .Row)
        Set org1 = Range("E" & tr)

        On Error Resume Next
        Me.Shapes("$E$" & tr).Delete
        Sheets("Sheet2").Shapes("$E$" & tr).Delete
        On Error GoTo 0

        On Error Resume Next
        With ActiveSheet.Pictures.Insert(Range("D" & .Row).Value & ".jpg")
            If Err.Number <> 0 Then
                MsgBox "画像挿入は出来ませんでした。"
                Exit Sub
            End If
            .Name = org1.Address
            .Left = org1.Left
            .Top = org1.Top
            .Width = org1.Width
            .Height = org1.Height
        End With
        On Error GoTo 0
    End With
 End Sub

 このロジックはそのまま使用して、
 その他に、オートシェイプにマクロ登録をして、そのマクロを、
 実行した時には、Sheet1の画像を一度削除し、
 例の行数の時は、A列に品番が入力されている物を、
 全て、画像挿入していきたいです。

 (saru)


 えっと・・・
 >@を実行した場合、自動で同じ画像ファイル名の所に自動でシート(sheet1)の
 >画像を貼り付けたいのですが
 ってのは やらなくて良くなった ってことですか?

 (HANA)

 (HANA)様へ

出来ればしたかったのですが・・・・出来ないと思いましたので、
前回のロジックでは、MsgBoxが出るだけでしたので・・・

すいませんでした。

 (saru)


 >>当初の二番目の御質問を含めて、こんな感じの事ですか?
 >と前回分を考慮いただきましたが、MsgBox "Sheet2にファイル名が有りません。"
 >と表示されます。
 >
 >以上よろしくお願いいたします。
 と言う事でしたので、その下のコメントは
 問題点を探すコードだったのですが・・・・
 まぁ、それならそれで宜しいかと思います。

 以下試していませんが・・・・
 A列に対して実行する物は

 ↓標準モジュールに
 Sub A列実行()
 Dim i As Long
    On Error Resume Next
        ActiveSheet.DrawingObjects.Delete
    On Error GoTo 0

    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1) <> "" Then Cells(i, 1) = Cells(i, 1)
    Next i
 End Sub

 としてみて下さい。

 なお、現在のシートモジュールに有るコードの内
 >Sheets("Sheet2").Shapes("$E$" & tr).Delete
 は不要ですので削除しておくのが良いと思います。

 (HANA)

 (HANA)様

ありがとうございます。
大枠は動くのですが、以下の件がおかしいです。
@ピップアップで、画像挿入できません、と表示されます。

Aオートシェイプにマクロ登録をして、マクロ(A列実行)を
 実行すると、画像は変わりますが、オートシェイプも消えてしまいます。
 オートシェイプにマクロ登録した物を、消さなくする方法はありませんでしょうか?

何度もすみません。

(saru)


 「ピップアップ」ってのは何ですかね?
 まさか
 「ピップアップで、画像挿入できません」と言うメッセージ
 ・・・って事は無いと思いますが・・・。

 メッセージボックスで「画像挿入は出来ませんでした。」と出る
 って事ですかね?

 でしたら、挿入できなかったんだと思いますけど・・・。

 (2)については A列実行 コードの前半部分
    On Error Resume Next
        ActiveSheet.DrawingObjects.Delete
    On Error GoTo 0
 を消してください。

 (HANA)


(HANA)様へ

「ピップアップで、画像挿入できません」と言うメッセージは、
「ポップアップで、画像挿入できません」と言うメッセージです、すみません・・・

(2)については 問題なく出来ました。
ありがとうございます。

(saru)


 コードから出るエラーメッセージは
 >メッセージボックスで【画像挿入は出来ませんでした。】
 です。

 ただ
 >【ポップアップで、画像挿入できません】と言うメッセージ
 と言う事なんですよね??

 それで画像挿入処理が途中で終わるのですか?
 それとも、終わって見れば 画像は正しく挿入されているにも関わらず
 途中(あるいは最後?)でメッセージが出るのでしょうか?
 そのメッセージはいつ出るのでしょうか?

 (HANA)


(HANA)様へ

>>【ポップアップで、画像挿入できません】と言うメッセージ
> と言う事なんですよね??

 そうです。

>そのメッセージはいつ出るのでしょうか?

 終わって見れば 画像は正しく挿入されているにも関わらず最後にメッセージが出ます。

*又ちなみに、もうひとつ要望が発生しましたので、問い合わせます。
現在、以下の通りで想定していますが、

    A       B         C      D          E
 1 商品名	ファイル名	    リンク場所     画像	       8
 2 101004	101004_bl_o	D:\data\	   D:\data\101004_bl_o	
 3 101009	101009_bl_a	D:\data\	   D:\data\101009_bl_a	
 4 101010	101010_bl_a	D:\data\    D:\data\101010_bl_a	
 5 101011	101011_bl_o	D:\data\    D:\data\101011_bl_o	

    A       B         C      D          E
 1 商品名	ファイル名	    リンク場所  	画像	       8
 2 101004	101004_bl_o	D:\data\	   D:\data\101004_bl_o	
 3 A2とセル結合                              E2とセル結合
 4 A2とセル結合                              E2とセル結合
 5 101009	101009_bl_a	D:\data\	   D:\data\101009_bl_a	
 6 A5とセル結合                              E5とセル結合
 7 A5とセル結合                              E5とセル結合
 8 101010	101010_bl_a	D:\data\    D:\data\101010_bl_a	
 9 A8とセル結合                              E8とセル結合
 10 A8とセル結合                              E8とセル結合
 11 101011	101011_bl_o	D:\data\    D:\data\101011_bl_o	
 12 A11とセル結合                              E11とセル結合
 13 A11とセル結合                              E11とセル結合
となります。(ただし、セルの結合される行数が3行ですが、6行になるかもしてません。)
行数が増えても、画像挿入はうまくいきましたが、セルの結合分にはならず、単独の
セルの範囲に挿入される状態です。セル結合された範囲に画像挿入は可能でしょうか?

何度もすみませんが、よろしければ、ご回答下さい。

(saru)


 一応確認・・・・。

 ↓のコードを標準モジュールへ
 Sub テスト()
 Dim i As Long
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1) <> "" Then Cells(i, 1) = Cells(i, 1)
    Next i
    MsgBox "A列実行完了"
 End Sub

 「ポップアップで、画像挿入できません」が「A列実行完了」の
 前に出るか後に出るか 教えて下さい。

 もう一つのご質問に関しては、単純に
 Height に結合セル倍した数を入れるのでは駄目でしょうか?
            .Height = org1.Height * 3
 ってなかんじで。

 検証してませんので、駄目でしたら模索して下さい。

 (HANA)


(HANA)様へ

 > 「ポップアップで、画像挿入できません」が「A列実行完了」の
 > 前に出るか後に出るか 教えて下さい。
「ポップアップで、画像挿入できません」が出てから、「A列実行完了」のポップアップが出ますので、
前に出ています。

 > もう一つのご質問に関しては、単純に
 > Height に結合セル倍した数を入れるのでは駄目でしょうか?
 >            .Height = org1.Height * 3
 > ってなかんじで。
うまくいきました。ありがとうございます。

(saru)


 う〜ん、それでは
 ↓で最終行を確認
 Sub テスト2()
    MsgBox Cells(Rows.Count, 1).End(xlUp).Row
 End Sub

 最終行のA列のセルから 値を一つずつ入れ直して行った時
 ポップアップが出るのはどこですかね?

 (HANA)

(HANA)様へ

 >最終行のA列のセルから 値を一つずつ入れ直して行った時ポップアップが出るのはどこですかね?
そうです。

テストをすると、22となったので、そのセルを見ると、スペースが入っていましたので、
削除すると、14となり、ポップアップしませんでした。
ありがとうございます。

*もし、A列又は、B列で入力後エンターを押すとその行のE列に画像を挿入していますが、
B列のみとか、F列に変更する事は可能でしょうか?

(saru)


 はい、後は細かい変更でいけると思いますよ。

 それと他にも、
 「org2 As Range」「kst As String」と「kst = Range("B" & .Row)」
 は使用していないので削除しておいて下さい。

 関係ない物が混ざっていると、コードがわかりにくくなりますからね。

 (HANA)

(HANA)様へ

削除はいたしました。

If .Column > 2 Then Exit Sub
  ↓
If .Column <> 2 Then Exit Sub

にしてみましたが、セルに入力時は、B列のみで、画像を挿入していますが、
マクロを実行すると、何も表示できません。
他にも変えるところがあるのでしょうか?

(saru)


 えっと、マクロの方も変更して下さいよ?

 A列実行  マクロは、A列のセルの値を入れ直しています。

  (HANA)

(HANA)様へ

A列実行 マクロの修正をしましたら、出来ました。
色々とすみませんでした。
*マクロのところで、使った事が無い物があり、勉強になりました。

また、変更等で質問するかもしれませんが、その時はよろしくお願いいたします。

(saru)


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.