[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『自動画像表示』(saru)Excel2003 Windows XP
どうすればいいかわからなくなり質問させていただきます。
やりたい事は、以下の通りです。
@あるシート(sheet1)の列(A)に画像ファイルを入力しエンターキーを押すたびに、 自動で、決まったフォルダー(例 D:\data\)に入っている jpg又は、ビットマップ、GIFファイルを、 列(B)に挿入し、画像をセルの大きさに自動調整をして、 セルと画像をグループ化したいのですが、出来ますでしょうか?
A別シート(sheet2)に、シート(sheet1)の結果から編集作業をしたいので、 @を実行した場合、自動で同じ画像ファイル名の所に自動でシート(sheet1)の 画像を貼り付けたいのですが可能でしょうか? *シート(sheet1)と、シート(sheet2)のセルの位置は違います。
以上よろしくお願いいたします。
指定画像挿入の過去ログです。 [[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)
「ピップアップで、画像挿入できません」と言うメッセージは、
「ポップアップで、画像挿入できません」と言うメッセージです、すみません・・・
(2)については 問題なく出来ました。
ありがとうございます。
(saru)
コードから出るエラーメッセージは >メッセージボックスで【画像挿入は出来ませんでした。】 です。
ただ >【ポップアップで、画像挿入できません】と言うメッセージ と言う事なんですよね??
それで画像挿入処理が途中で終わるのですか? それとも、終わって見れば 画像は正しく挿入されているにも関わらず 途中(あるいは最後?)でメッセージが出るのでしょうか? そのメッセージはいつ出るのでしょうか?
(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)
> 「ポップアップで、画像挿入できません」が「A列実行完了」の > 前に出るか後に出るか 教えて下さい。 「ポップアップで、画像挿入できません」が出てから、「A列実行完了」のポップアップが出ますので、 前に出ています。
> もう一つのご質問に関しては、単純に > Height に結合セル倍した数を入れるのでは駄目でしょうか? > .Height = org1.Height * 3 > ってなかんじで。 うまくいきました。ありがとうございます。
(saru)
う〜ん、それでは ↓で最終行を確認 Sub テスト2() MsgBox Cells(Rows.Count, 1).End(xlUp).Row End Sub
最終行のA列のセルから 値を一つずつ入れ直して行った時 ポップアップが出るのはどこですかね?
(HANA)
>最終行のA列のセルから 値を一つずつ入れ直して行った時ポップアップが出るのはどこですかね? そうです。
テストをすると、22となったので、そのセルを見ると、スペースが入っていましたので、
削除すると、14となり、ポップアップしませんでした。
ありがとうございます。
*もし、A列又は、B列で入力後エンターを押すとその行のE列に画像を挿入していますが、
B列のみとか、F列に変更する事は可能でしょうか?
(saru)
はい、後は細かい変更でいけると思いますよ。
それと他にも、 「org2 As Range」「kst As String」と「kst = Range("B" & .Row)」 は使用していないので削除しておいて下さい。
関係ない物が混ざっていると、コードがわかりにくくなりますからね。
(HANA)
削除はいたしました。
If .Column > 2 Then Exit Sub
↓
If .Column <> 2 Then Exit Sub
にしてみましたが、セルに入力時は、B列のみで、画像を挿入していますが、
マクロを実行すると、何も表示できません。
他にも変えるところがあるのでしょうか?
(saru)
えっと、マクロの方も変更して下さいよ?
A列実行 マクロは、A列のセルの値を入れ直しています。
(HANA)
A列実行 マクロの修正をしましたら、出来ました。
色々とすみませんでした。
*マクロのところで、使った事が無い物があり、勉強になりました。
また、変更等で質問するかもしれませんが、その時はよろしくお願いいたします。
(saru)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.