[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力値によって、決められた図の表示』（MIU）
お世話になります。教えてください。
セルA1に、「N」、「X」、「K]、「HK」、「XX」、「KK」、「KKK」の7種類の
文字を入力したときに、各文字に対応した図（JPGファイル、もしくはオートシェイプの
図）を
指定したセル上（例：Ｂ１の位置）
に表示させたいのですが、
この時、文字に「１〜１５」の倍数がある場合（例：１０ＨＫ等）は
図も倍数分表示（例：１０ＨＫ→ＨＫに対応した図を横並びに１０個表示）したいのですが、
エクセルでこのような事は可能でしょうか？
[エクセルのバージョン]Excel2003
[OSのバージョン]WindowsXP
マクロ(VBA)を使えば可能です。
(INA)
お返事ありがとうございます。
マクロ（ＶＢＡ）でのプログラミングになると
作成について全く知識がないので、
大変恐縮ですが、どのようにすれば上記の内容が出来るか
お教えいただけませんでしょうか？
（MIU）
仕様を明確にする必要があります。
>各文字に対応した図（JPGファイル、もしくはオートシェイプの図） これについて詳しく教えて下さい。
>この時、文字に「１〜１５」の倍数がある場合（例：１０ＨＫ等）は 全角文字なのですか？
(INA)
対応した図は、JPGファイル（ファイル名は、各文字に併せて「n.jpg〜kkk.jpg」）とします。
また、文字・数値とも小文字で半角文字とします。（例：10hk)
この条件で、お願い致します。
（MIU）
JPGファイル はどこに保存されているものですか？ Excelのブックと同じフォルダですか？
(INA)
倍数が偶数番目の図だけ、左右反転表示っていうのは可能でしょうか？
例えば、「７ｋ」の図を表示するとき、「１、３、５、７番目はそのまま表示で
「２、４、６」番目の図は、左右反転で図を表示することは出来ますか？
（１８０度回転した状態）
もし、今からでも間に合いましたら補足していただけないでしょうか？
大変申し訳ありませんが、何卒宜しくお願い致します。
（MIU)
INAさんがお作りになってる間に、左右反転の分だけ・・・。 エクセル上ではjpgの反転は出来ません。 フォトエディタなど画像編集ソフトで左右反転した画像をk180などとして、 条件分岐するようになるんじゃないかな・・・。 INAさんがどのようなものを作っているのか、o(^-^)oワクワク （川野鮎太郎）
大変な作業とは思いますが、何卒宜しくお願い致します。
（MIU）
鮎太郎さんのおっしゃるように、Excelに画像反転の機能がないので >左右反転した画像をk180などとして、条件分岐するようになる とするのが簡単かと思います。
>これは出来たらで良いのですが とのことなので、当然含まれておりません。
>どのようなものを作っているのかo(^-^)oワクワク たぶん誰が作っても同じような感じだと思いますよ。。(^_^;)
Private Sub Worksheet_Change(ByVal Target As Range) Dim myStr() As Variant Dim i As Long, c As Long Dim col As Long
If Target.Address(0, 0) <> "A1" Then Exit Sub
If Target.Value = "" Then Exit Sub
myStr() = Array("n", "x", "k", "hk", "xx", "kk", "kkk")
For i = 6 To 0 Step -1
If InStr(Target.Value, myStr(i)) > 0 Then GoTo next1 '画像の表示へ
Next i
MsgBox "入力文字が正しくありません", vbExclamation, "エラー"
Exit Sub '終了
next1: '画像の表示
If Dir(ThisWorkbook.Path & "\" & myStr(i) & ".jpg") = "" Then
MsgBox myStr(i) & ".jpg が見つかりません。終了します。", vbExclamation, "エラー"
Exit Sub
End If
Range("B1").Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
For c = 2 To Val(Target.Value)
Cells(1, col + 1).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
Next c
End Sub
(INA)
INA様
ありがとうございます。
早速、試させていただきます。
マクロでの作成については、知識が無いのですが、INA様に作って頂きましたプログラムを
少しでも理解出来るように努力してみます。
貴重なお時間をいただきまして、本当にありがとうございました。
ちなみに、反転表示の分岐の条件も、宜しければお願い出来ませんでしょうか？
（MIU）
どうぞ。
*反転画像のファイル名は k180.jpg のように 180 を付与してください。
Private Sub Worksheet_Change(ByVal Target As Range) Dim myStr() As Variant Dim i As Long, c As Long Dim col As Long
If Target.Address(0, 0) <> "A1" Then Exit Sub
If Target.Value = "" Then Exit Sub
myStr() = Array("n", "x", "k", "hk", "xx", "kk", "kkk")
For i = 6 To 0 Step -1
If InStr(Target.Value, myStr(i)) > 0 Then GoTo next1 '画像の表示へ
Next i
MsgBox "入力文字が正しくありません", vbExclamation, "エラー"
Exit Sub '終了
next1: '画像の表示
On Error GoTo ErrTrap
Range("B1").Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
For c = 2 To Val(Target.Value)
Cells(1, col + 1).Select
Select Case c Mod 2
Case 0 '偶数
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & "180.jpg").Select
Case Else
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
End Select
col = Selection.BottomRightCell.Column
Next c
Exit Sub '終了
ErrTrap: 'エラー処理
MsgBox "画像ファイルが見つかりません。終了します。", vbExclamation, "エラー"
End Sub
(INA)
本当に助かりました。ありがとうございました。
上記のプログラムを、そのまま使用するのではなくて
自分なりに理解出来るようにがんばってみます。
本当にありがとうございました。
（MIU）
>自分なりに理解出来るようにがんばってみます。 そのように言っていただけると幸いです。 私は仕様丸投げのマクロ作成依頼はたいてい断っているのですが、 ちょっとアドバイスしただけで作れる内容のマクロではないですし、 少し、ひまだったので作らせて頂きました。 何か分からないことがあれば、また質問して下さい。
[参考サイト] http://www.sanynet.ne.jp/~awa/excelvba/kouza.html http://www6.plala.or.jp/MilkHouse/menu.html http://t_shun.at.infoseek.co.jp/My_Page/Excel-VBA/vba_menu.htm http://www.geocities.jp/vbaxl/ (INA)
いきなりマクロを使いこなすのは難しくても、教えて頂いた内容だけでも理解して
自分なりに改良にも挑戦してみようと思います。
（MIU）
早速ですが、作っていただきましたプログラムを少し改良したいのですが、
条件の考え方までは組み立てが出来たのですが、
いざプログラムとなると、作成の仕方がまだよくわかりません。
大変申し訳ありませんが、次の様な仕様でのプログラム改良についてのご指導お願いできないでしょうか？
（以下、改良ポイントについてと、自分なりに考えてみた条件の組み立てです。）
改良ポイント
・奇数倍の時、中央からの並びをそれまでの逆を表示したい。
例（正規表示を「a」、反転表示を「b」とします。）：５K→（a、b、a、b、a）を（a、b、a、a、b）にしたい。
・「n」については、奇数倍の時中央を「x.jpg」を表示し、
中央から左側を全て「n.jpg」右側を「n180.jpg」と表示したい。
例（正規表示を「a」、反転表示を「b」とし、中央を「x」とします。）：5n→（a、a、x、b、b）としたい。
考えてみた条件の組み立てですが、
・セルA1に７種類の文字「k」、「hk」、「kk」、「kkk」、「x」、「xx」「n」を入力したときに
各文字に対応するjpgファイル
「k.jpg」、「hk.jpg」、「kk.jpg」、「kkk.jpg」、「x.jpg」、「xx.jpg」「n.jpg」、
及び上記jpgファイルの反転表示の
「k180.jpg」、「hk180.jpg」、「kk180.jpg」、「kkk180.jpg」、「x180.jpg」、「xx180.jpg」「n180.jpg」
をB1に表示をします。ただし、各7種類の文字に倍数1〜１５までの整数がある時、
その倍数分jpgファイルを右に向かって並べて表示します。
例：「5hk」は、「hk.jpg」と「hk180.jpg」を条件に合わせて5つ右並びに表示します。
・倍数を「c」として、「c」は１〜１５までの整数とします。
（また、条件式中の「c/２」は小数点以下切捨ての整数とします。）
・表示するjpgファイルは、条件によって正規表示・反転表示として
正規表示を「a」、反転表示を「b」とします。
条件１：「k」、「hk」、「kk」、「kkk」、「x」、「xx」「n」について、
「c」が偶数の時は、ｃの奇数番目を正規表示「a」、偶数番目を反転表示「b」と表示します。
例：c＝８の時、（a、b、a、b、a、b、a、b）とします。
条件２：「c」が奇数の時は、
・「k」、「hk」、「kk」、「kkk」、「x」、「xx」については、
（c/２+1）番目までは、条件１と同じくｃの奇数番目を正規表示「a」、偶数番目を反転表示「b」とし、
（c/2+2）番目からは、ｃの偶数番目を正規表示「a」、奇数番目を反転表示「b」と表示します。
例：c＝７の時、（a、b、a、b、a、b、a）ではなくて、（a、b、a、b、b、a、b）と表示します。
・「n」については、
（c/2）番目までは全て「a」、
（c/2+1）番目は「x.jpg」を表示し、
(c/2+2)番目から全て「b」と表示します。
（MIU）
先日はありがとうございました。
作って頂きましたVBAを少し改良したくて（改良ポイントについて上記参考）
、INA様に教えて頂きましたサイトを参考に作成してみたのですが、
エラーが表示されないのに図の表示がされずに困っています。
もし宜しければ、どこが違うかご指導いただけませんでしょうか？
宜しくお願い致します。
Private Sub Worksheet_Change(ByVal Target As Range) Dim myStr() As Variant Dim i As Long, c Dim col As Long
If Target.Address(0, 0) <> "A1" Then Exit Sub
If Target.Value = "" Then Exit Sub
myStr() = Array("n", "x", "k", "hk", "xx", "kk", "kkk")
For i = 6 To 0 Step -1
If InStr(Target.Value, myStr(i)) > 0 Then GoTo next1 '画像の表示へ
Next i
MsgBox "入力文字が正しくありません", vbExclamation, "エラー"
Exit Sub '終了
next1: '画像の表示
On Error GoTo ErrTrap
Range("B1").Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
For c = 2 To Val(Target.Value)
Cells(1, col + 1).Select
Select Case i
Case Is < 6 '「"x", "k", "hk", "xx", "kk", "kkk"」について
Select Case c Mod 2 '倍数ｃについて
Case 0 '倍数ｃが偶数の時
Select Case c Mod 2 '偶数・奇数番を求める
Case 0 '偶数→反転表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & "180.jpg").Select
Case Else '奇数→正規表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
End Select
Case Else '倍数ｃが奇数のとき
Select Case c '奇数の時の並びの条件に当てはめる
Case Is <= (Val(Target.Value) / 2) + 1 '倍数cが（ｃ/2）+1番目まで
Select Case c Mod 2
Case 0 '偶数→反転表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & "180.jpg").Select
Case Else '奇数→正規表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
End Select
Case Is >= (Val(Target.Value) / 2) + 2 '倍数cが（ｃ/2）+2番目以降
Select Case c Mod 2
Case 0 '偶数→正規表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
Case Else '奇数→反転表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & "180.jpg").Select
col = Selection.BottomRightCell.Column
End Select
End Select
Case 6 '「"n"」について
Select Case c Mod 2 '倍数ｃについて
Case 0 '倍数ｃが偶数の時
Select Case c Mod 2 '偶数・奇数番を求める
Case 0 '偶数→反転表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & "180.jpg").Select
Case Else '奇数→正規表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
End Select
Case Else '倍数ｃが奇数の時
Select Case c '奇数の時の並びの条件に当てはめる
Case Is <= (Val(Target.Value) / 2) '倍数ｃがｃ/2番目まで、正規表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
Case (Val(Target.Value) / 2) + 1 '倍数ｃが（ｃ/2）+1番目の時、「x.jpg」を表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & "x.jpg").Select
Case Is >= (Val(Target.Value) / 2) + 2 '倍数ｃが（ｃ/2）+2番目以降、反転表示
ActiveSheet.Pictures.Insert _
(ThisWorkbook.Path & "\" & myStr(i) & "180.jpg").Select
col = Selection.BottomRightCell.Column
End Select
End Select
Next c
End Select
Exit Sub '終了
ErrTrap: 'エラー処理
MsgBox "画像ファイルが見つかりません。終了します。", vbExclamation, "エラー"
End Sub
すみません見落としていました。時間が空いたら確認させていただきます。
ちなみに今回のような状況で動作を確認するときは、 VBEの画面で、ローカルウィンドウを表示しておき、 Ｆ８キーでステップ実行してみて下さい。 (INA)
お返事ありがとうございます。
昨日、書き込みしてから、なんとかここまで教えてもらったサイトを見ながら
がんばってみたのですが、やはりまだプログラムの意味を全部把握できてないので
プログラムがうまく動作しません。
何卒、宜しくお願い致します。
（MIU)
すごい頑張ってますね。おどろきました。 ひとまず作ってみましたが、 ほとんど動作確認してませんので、不具合があったら言って下さい。
Private Sub Worksheet_Change(ByVal Target As Range) Dim myStr() As Variant Dim i As Long, c As Long Dim col As Long Dim myFile As String '画像ファイル名
If Target.Address(0, 0) <> "A1" Then Exit Sub
If Target.Value = "" Then Exit Sub
myStr() = Array("n", "x", "k", "hk", "xx", "kk", "kkk")
For i = 6 To 0 Step -1
If InStr(Target.Value, myStr(i)) > 0 Then GoTo next1 '画像の表示へ
Next i
MsgBox "入力文字が正しくありません", vbExclamation, "エラー"
Exit Sub '終了
next1: '画像の表示----------------------------- On Error GoTo ErrTrap
'-----１枚目表示------
Range("B1").Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myStr(i) & ".jpg").Select
col = Selection.BottomRightCell.Column
'１枚のときは終了
If Val(Target.Value) = 0 Or Val(Target.Value) = 1 Then
Range("A1").Activate
Exit Sub
End If
'====２枚以上の処理====
'[奇数で n のとき]
If Val(Target.Value) Mod 2 = 1 And myStr(i) = "n" Then
For c = 2 To Val(Target.Value)
Cells(1, col + 1).Select
If c = Int(Val(Target.Value) / 2 + 1) Then '中央の画像
myFile = "x.jpg"
ElseIf c <= Int(Val(Target.Value) / 2) Then '前半の画像
myFile = "n.jpg"
Else '後半の画像
myFile = "n180.jpg"
End If
'画像挿入
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myFile).Select
col = Selection.BottomRightCell.Column
Next c
'[奇数のとき]
ElseIf Val(Target.Value) Mod 2 = 1 Then
For c = 2 To Val(Target.Value)
Cells(1, col + 1).Select
'前半の画像
If c <= Int(Val(Target.Value) / 2 + 1) Then
Select Case c Mod 2
Case 0 '偶数
myFile = myStr(i) & "180.jpg"
Case Else '奇数
myFile = myStr(i) & ".jpg"
End Select
'後半の画像
Else
Select Case c Mod 2
Case 0 '偶数
myFile = myStr(i) & ".jpg"
Case Else '奇数
myFile = myStr(i) & "180.jpg"
End Select
End If
'画像挿入
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myFile).Select
col = Selection.BottomRightCell.Column
Next c
'[偶数のとき]
Else
For c = 2 To Val(Target.Value)
Cells(1, col + 1).Select
Select Case c Mod 2
Case 0 '偶数
myFile = myStr(i) & "180.jpg"
Case Else '奇数
myFile = myStr(i) & ".jpg"
End Select
'画像挿入
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myFile).Select
col = Selection.BottomRightCell.Column
Next c
End If
'+++ 終 了 +++
Range("A1").Activate
Exit Sub
'エラー処理----------------------------
ErrTrap:
MsgBox "画像ファイルが見つかりません。終了します。", vbExclamation, "エラー"
End Sub
試しに使用させてもらいましたが、きちんと動作します。
ありがとうございました。
今回作って頂きましたプログラムの内容を理解出来るようにがんばってみます。
宜しければ、またわからない点がでてきたら教えてください。
宜しくお願い致します。
（MIU)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.