Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9800 / 13646 ツリー ←次へ | 前へ→

【25378】画像を出したい きし 05/5/30(月) 11:16 質問[未読]
【25382】Re:画像を出したい Kein 05/5/30(月) 11:33 回答[未読]
【25389】Re:画像を出したい きし 05/5/30(月) 12:09 質問[未読]
【25390】Re:画像を出したい Kein 05/5/30(月) 12:28 回答[未読]
【25391】Re:画像を出したい きし 05/5/30(月) 12:42 質問[未読]
【25392】Re:画像を出したい Kein 05/5/30(月) 13:10 発言[未読]
【25393】Re:画像を出したい Kein 05/5/30(月) 13:15 発言[未読]
【25396】Re:画像を出したい きし 05/5/30(月) 14:13 質問[未読]
【25405】Re:画像を出したい Kein 05/5/30(月) 17:14 回答[未読]
【25394】Re:画像を出したい きし 05/5/30(月) 13:18 質問[未読]
【25385】Re:画像を出したい Jaka 05/5/30(月) 11:40 質問[未読]
【25407】Re:画像を出したい きし 05/5/30(月) 17:37 お礼[未読]

【25378】画像を出したい
質問  きし  - 05/5/30(月) 11:16 -

引用なし
パスワード
   Dフォルダに1.jpgの画像があります。
ツール(右クリック)  
コントロールツールボックス
イメージをクリックして
Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .Address(0, 0) = "A1" Then
      If .Value = "" Then
        Me.Image1.Picture = Nothing
      Else
        Me.Image1.AutoSize = True
        Me.Image1.Picture = LoadPicture("D:\" & .Value & ".jpg")
      End If
    End If
  End With
End Sub
とすると通常A1のセルに1を入れると画像が出てくるはずなんですが
反応が無いので
sheet1を右クリック、コードの表示より
同じ文面を入力すると、なるほど1Aに1を入れると
画像が出てきます。

次にA2にも同じ作業が(A2に1を入れると1.jpgの画像が出てくる)
ようにしたいんですが、どのようにしたらいいのでしょうか?
はじめのやり方がうまくいくと、後は間単に行くような気がするのですが
よろしくお願い致します。

【25382】Re:画像を出したい
回答  Kein  - 05/5/30(月) 11:33 -

引用なし
パスワード
   A列のセルなら、どこでも 1 を入れて画像を表示する。ということなら

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .Column > 1 Then Exit Sub
    If IsEmpty(.Value) Then Exit Sub
    If Not Is Numeric Then Exit Sub
    On Error Resume Next
    Me.Image1.Picture = _
    LoadPicture("D:\" & Int(.Value) & ".jpg")
    Me.Image1.AutoSize = True
  End With
End Sub

【25385】Re:画像を出したい
質問  Jaka  - 05/5/30(月) 11:40 -

引用なし
パスワード
   こんにちは。

質問の意図が良く解りません。

▼きし さん:
>Dフォルダに1.jpgの画像があります。
>ツール(右クリック)  
>コントロールツールボックス
>イメージをクリックして
  ↑ 特に、この上辺りが
 略
>とすると通常A1のセルに1を入れると画像が出てくるはずなんですが
>反応が無いので
>sheet1を右クリック、コードの表示より
>同じ文面を入力すると、なるほど1Aに1を入れると
>画像が出てきます。
>
>次にA2にも同じ作業が(A2に1を入れると1.jpgの画像が出てくる)
>ようにしたいんですが、どのようにしたらいいのでしょうか?
>はじめのやり方がうまくいくと、後は間単に行くような気がするのですが
>よろしくお願い致します。

掲載されたコードは、シートのチェンジイベントですから、
Image1にコードを書いても動きませんです。
各シートのシートモジュールに書くか、全シート対象なら、Thisworkbookに書いてください。

ThisWorkbook
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)

【25389】Re:画像を出したい
質問  きし  - 05/5/30(月) 12:09 -

引用なし
パスワード
   ▼Kein さん:
>A列のセルなら、どこでも 1 を入れて画像を表示する。ということなら
>
▼Kein さん:
>A列のセルなら、どこでも 1 を入れて画像を表示する。ということなら

簡易カタログ作りを考えています。
画像を10枚ほど用意して、それぞれファイル名を1.jpg〜10.jpg
にふります。A1のセルに1を入れると、1.jpgの画像が
A2に3を入れると違う場所に3.jpgの画像がA3に6を入れると
6.jpgの画像が、・・・・これをたとえばA8まで続けると
8枚の画像が張り付いた簡易カタログができます。
そうしたいんですが。

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .Column > 1 Then Exit Sub
    If IsEmpty(.Value) Then Exit Sub
    If Not Is Numeric Then Exit Sub
    On Error Resume Next
    Me.Image1.Picture = _
    LoadPicture("D:\" & Int(.Value) & ".jpg")
    Me.Image1.AutoSize = True
  End With
End Sub
これをやりましたが、コンパイルエラー
If Not Is Numeric Then Exit Sub が斑点しています。
お忙しいところすみません。どうぞよろしくお願い致します。

【25390】Re:画像を出したい
回答  Kein  - 05/5/30(月) 12:28 -

引用なし
パスワード
   あー・・すいません。

If Not IsNumeric(.Value) Then

と、修正して下さい。

【25391】Re:画像を出したい
質問  きし  - 05/5/30(月) 12:42 -

引用なし
パスワード
   ▼Kein さん:
>あー・・すいません。
>
>If Not IsNumeric(.Value) Then
>
>と、修正して下さい。

出た〜〜出ました。ありがとうございます。

では、Aの各セルに違うNo.を入れて、画像を
複数出すようにしたいのですが、ここから
困難な作業でしょうか?よろしくお願い致します。

【25392】Re:画像を出したい
発言  Kein  - 05/5/30(月) 13:10 -

引用なし
パスワード
   >Aの各セルに違うNo.を入れて、画像を複数出す
そーいうコードにしたつもりですが、出ませんか ?

【25393】Re:画像を出したい
発言  Kein  - 05/5/30(月) 13:15 -

引用なし
パスワード
   Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
   If .Column > 1 Then Exit Sub
   If IsEmpty(.Value) Then Exit Sub
   If Not Is Numeric(.Value) Then Exit Sub
   On Error Resume Next
   Me.Image1.Picture = ""
   Me.Image1.Picture = _
   LoadPicture("D:\" & Int(.Value) & ".jpg")
   Me.Image1.AutoSize = True
  End With
End Sub

というように、いったん削除するのが定石だったかな。

【25394】Re:画像を出したい
質問  きし  - 05/5/30(月) 13:18 -

引用なし
パスワード
   ▼Kein さん:
>>Aの各セルに違うNo.を入れて、画像を複数出す
>そーいうコードにしたつもりですが、出ませんか ?

A1 2 3 に各一枚ずつやってみました。
そうすると、画像が変わるんですが
(最後に3の画像になります。)
123と3枚同時に出す方法は無いでしょうか?
要するに、合計8枚だして、それをそのまま
プリントアウトすると、8枚の画像の入った
カタログにしたいんですが・・・・。
(素人がむちゃくちゃ言ってたらすみません。)

【25396】Re:画像を出したい
質問  きし  - 05/5/30(月) 14:13 -

引用なし
パスワード
   ▼Kein さん:
>Private Sub Worksheet_Change(ByVal Target As Range)
>  With Target
>   If .Column > 1 Then Exit Sub
>   If IsEmpty(.Value) Then Exit Sub
>   If Not Is Numeric(.Value) Then Exit Sub
>   On Error Resume Next
>   Me.Image1.Picture = ""
>   Me.Image1.Picture = _
>   LoadPicture("D:\" & Int(.Value) & ".jpg")
>   Me.Image1.AutoSize = True
>  End With
>End Sub
>
>というように、いったん削除するのが定石だったかな。

これをやってみると
コンパイルエラー 型が一致しませんとで
Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
   If .Column > 1 Then Exit Sub
   If IsEmpty(.Value) Then Exit Sub
   If Not IsNumeric(.Value) Then Exit Sub
   On Error Resume Next
   Me.Image1.Picture = ""
   Me.Image1.Picture = _
   LoadPicture("D:\" & Int(.Value) & ".jpg")
   Me.Image1.AutoSize = True
  End With
End Sub
の文の""ここが斑点しています。
すみませんがよろしくお願い致します。

【25405】Re:画像を出したい
回答  Kein  - 05/5/30(月) 17:14 -

引用なし
パスワード
   >コンパイルエラー 型が一致しません
あー・・またまたすいません。

Me.Image1.Picture = LoadPicture("")

というように直して下さい。で、実際は
>合計8枚だして、それをそのまま
>プリントアウトすると、8枚の画像の入ったカタログにしたい
つまりサムネイルにしたいわけですね ? そーいうのは専用の画像処理ソフト
などでやるのが本来のやり方ですが、いちおうワークシートに直接並べるとして

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim MyF As String
  Dim Cnt As Integer, Ans As Integer
  Dim Lp As Single, Tp As Single, Wp As Single
 
  With Target
   If .Column > 1 Then Exit Sub
   If IsEmpty(.Value) Then Exit Sub
   If Not IsNumeric(.Value) Then Exit Sub
   MyF = "D:\" & Int(.Value) & ".jpg"
   If Dir(MyF) = "" Then
     MsgBox "そのファイルは見つかりません", 48
     Application.EnableEvents = False
     Target.ClearContents: Target.Select
     Application.EnableEvents = True
     Exit Sub
   End If
  End With
  Cnt = ActiveSheet.Pictures.Count
  Lp = Range("B1").Left
  Wp = Range("B1").Resize(, 2).Width
  Select Case Cnt
   Case 0: Tp = 0
   Case 1 To 3
     Lp = Cnt * Wp + Lp: Tp = 0
   Case 4 To 7
     Lp = (Cnt - 4) * Wp + Lp: Tp = Wp
   Case Else
     Application.EnableEvents = False
     Target.ClearContents: Target.Select
     Application.EnableEvents = True
     Ans = MsgBox("画像ファイルは 8枚挿入済みです" & _
     vbLf & "すべて破棄しますか", 36)
     If Ans = 7 Then Exit Sub
     ActiveSheet.Pictures.Delete: Exit Sub
  End Select
  With ActiveSheet.Pictures.Insert(MyF)
   .Left = Lp: .Top = Tp
   .Width = Wp: .Height = Wp
  End With
End Sub

と、変更してみて下さい。

【25407】Re:画像を出したい
お礼  きし  - 05/5/30(月) 17:37 -

引用なし
パスワード
   あんぐり。すごい。ありがとうございました。
もう一度質問させていただきますので、
どうぞよろしくおねがいいたします。

9800 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free