[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『「×」が表示された時、ビープ音などを鳴らす』（やま）
◎ 下記の表で、判定欄（F11:F20）セルに「×」が出た時に「ブブー」等と。
1 回 10級
みとり算 合計 判定 80 80 合格
1 280 ◎ 2 224 ◎ 3 200 × 4 97 ◎ 5 302 ◎ 6 220 ◎ 7 283 ◎ 8 146 × 9 146 ◎ 10 288 ◎
◎ VBAについては、初心者で参考図書やWebサイトからの資料などをみて 下記のようにしてみました。
◎ 上記Excelファイルを表示して、Alt+F11でエディタを起動。 プロジェクト エクスプローラウィンドウの「標準モジュール」に。 （記述できていると思います。）
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
◎ こちらを、上記と同様のウィンドウ内の、Excek Object Sheet4(10級) コードに。
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then
If Range("f11:f20") ="×" Then
Call Beep(2000, 500)
End If
End If
End Sub
◎ どこを「修正」したらよいのか、また、他にも「前もっての諸設定」が有るのか？ ご教示をお願いします。 このPC＝Excel2010ですが、使用するのは、Excel2003ですが、大丈夫でしょうか？
Windwos XP SP=3 Excel2010 IE=8
どの時点で×がつくんですかね？ (ROUGE)
(ROUGE)さん：
◎ 早々にありがとうございます。失礼しました。
答案用紙の3番で言いますと、E13セルの「200」が入力された時点に「判定」しています。
'=IF(E13="","",IF(INDEX($J$6:$P$15,MATCH(D13,$I$6:$I$15,0),MATCH($D$4,$J$4:$P$ のように、「回答一覧表」を参照しています。 以上でよろしいでしょうか？ よろしくお願いします。 （やま）
だとすれば、E13（だけではないですよね？）を含む回答を入力する欄に変更が加わった時点で、
判定欄に×が入っているかを確認すればよさそうですね。
(ROUGE)
'--------以下、Sheet Module--------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rr As Range, cc As Range
Set rr = Range("E11:E20") '<--回答を入力するセル
If Not Intersect(Target, rr) Is Nothing Then
For Each cc In Intersect(Target, rr)
If cc.Offset(, 1).Value = "×" Then
Call Melody
End If
Next
End If
End Sub
'--------以下、標準Module--------
Private Declare Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Sub Melody()
Const Do1 As Double = 523.25
Const Re1 As Double = 587.32
Const Mi1 As Double = 659.25
Const Fa1 As Double = 698.45
Const Sol1 As Double = 783.99
Const La1 As Double = 880
Const blnk As Double = 20000
Dim snd(), lng(), i As Long
snd = Array(La1, Sol1, La1, blnk, Sol1, Fa1, Mi1, Re1, Do1, blnk, Re1)
lng = Array(125, 125, 1500, 250, 125, 125, 125, 125, 375, 125, 1500)
For i = 0 To UBound(snd)
Beep snd(i), lng(i)
Next
End Sub
◎ ご教示ありがとうございました。「成功」しました。感謝です！
◎ 質問を改めないといけないかもしれませんが、
同じ上記の表で、「合格」＝70点以上 の時には、「いい音」を鳴らす。
D9セルには =COUNTIF(F11:F20,"◎")*10
E9セルには =D9 （◎一個１０点です。ここへの表示は、「0」から「100」
10ポイント加算表示です。）
F9セルには =IF(E9="","",IF(E9>=70,"合格",""))
Sheet Module に
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then
If Range("e9")>70 Then
Call Beep(2000, 500)
End If
End If
End Sub
では、いけないのでしょうか？ お願いします。 （やま）
こんな感じでどうでしょうか。
すべて差し換えてください。
(ROUGE)
'-------以下、Sheet Moduleへ--------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rr As Range, cc As Range
Set rr = Range("E11:E20") '<--回答を入力するセル
If Not Intersect(Target, rr) Is Nothing Then
If WorksheetFunction.CountA(rr) = rr.Cells.Count Then
If Range("E9").Value >= 70 Then
Call Good_Melody
MsgBox "合格!"
Else
Call Bad_Melody
MsgBox "不合格...orz"
End If
Else
For Each cc In Intersect(Target, rr)
If cc.Offset(, 1).Value = "×" Then
Call Bad_Melody
End If
Next
End If
End If
End Sub
'-------以下、標準Moduleへ----------
Private Declare Function Beep Lib "kernel32" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Const La_1 As Double = 110
Const La_1s As Double = 116.54
Const Si_1 As Double = 123.47
Const Do0 As Double = 130.81
Const Do0s As Double = 138.59
Const Re0 As Double = 146.83
Const Re0s As Double = 155.56
Const Mi0 As Double = 164.81
Const Fa0 As Double = 174.61
Const Fa0s As Double = 184.99
Const Sol0 As Double = 195.99
Const Sol0s As Double = 207.65
Const La0 As Double = 220
Const La0s As Double = 233.08
Const Si0 As Double = 246.94
Const Do1 As Double = 261.62
Const Do1s As Double = 277.18
Const Re1 As Double = 293.66
Const Re1s As Double = 311.12
Const Mi1 As Double = 329.62
Const Fa1 As Double = 349.22
Const Fa1s As Double = 369.99
Const Sol1 As Double = 391.99
Const Sol1s As Double = 415.3
Const La1 As Double = 440
Const La1s As Double = 466.16
Const Si1 As Double = 493.88
Const Do2 As Double = 523.25
Const Do2s As Double = 554.36
Const Re2 As Double = 587.32
Const Re2s As Double = 622.25
Const Mi2 As Double = 659.25
Const Fa2 As Double = 698.45
Const Fa2s As Double = 739.98
Const Sol2 As Double = 783.99
Const Sol2s As Double = 830.6
Const La2 As Double = 880
Const La2s As Double = 932.32
Const Si2 As Double = 987.76
Const Do3 As Double = 1046.5
Const Do3s As Double = 1108.73
Const Re3 As Double = 1174.65
Const Re3s As Double = 1244.5
Const Mi3 As Double = 1318.51
Const Fa3 As Double = 1396.91
Const Fa3s As Double = 1479.97
Const Sol3 As Double = 1567.98
Const Sol3s As Double = 1661.21
Const La3 As Double = 1760
Const La3s As Double = 1864.65
Const Si3 As Double = 1975.53
Const Do4 As Double = 2093
Const blnk As Double = 20000
Sub Bad_Melody()
Dim snd(), lng(), i As Long
snd = Array(La1, Sol1, La1, blnk, Sol1, Fa1, Mi1, Re1, Do1s, blnk, Re1)
lng = Array(100, 100, 900, 100, 100, 100, 100, 100, 300, 100, 800)
For i = 0 To UBound(snd)
Beep snd(i), lng(i)
Next
End Sub
Sub Good_Melody()
Dim snd(), lng(), i As Long
snd = Array(Fa1, Fa1, Fa1, Fa1, blnk, Re1s, blnk, Sol1, blnk, Fa1)
lng = Array(100, 100, 100, 400, 100, 400, 100, 400, 100, 1200)
For i = 0 To UBound(snd)
Beep snd(i), lng(i)
Next
End Sub
(ROUGE) さん：
◎「完璧」です。重ねての、ご丁寧なご教示に感謝しております。 ありがとうございました。
まだ、進化？させていきたいと考えておりますので、その節は、またよろしくお願いし ます。 （やま）
ある程度、音階は揃えましたので、遊んでみてください。 （曲を組むのに一番時間がかかる＾＾；） (ROUGE)
(ROUGE) さん：
◎ 大変な作業を、甘えて恐縮です。見事な作曲に感謝です！ ６台のＰＣに入れました。早速、子供たちの「笑顔」の反応でした。( ^)o(^ ) ◎ 低学年用には、「合格！」を「やったね！」に「不合格」を「ざんねん！」に変更しています。
Ｑ１ 文字サイズなどの変更（ウィンドウ枠サイズ）についてご教示ください。
With .Font .Name = "ＨＧ創英角ポップ体" .FontStyle = "太字" .Size = 14 .ColorIndex = 3 End With
◎ 参考図書をみていますが、フォント・色（赤）・14ポイントサイズ に変更して 「やったね！」だけは、ウィンドウ表示枠を、大きくしたいのですが。 上記のような？のを、 どこへ「追加記述」すればよいのでしょうか？
Ｑ２ 「回答を入力するセル番地」が複数個所の場合について、ご教示ください。
◎ 前回ご教示いただきました「解答表」に、レベルにより種目が追加されて入力枠が増えます。
◎ 今のブック（Ａ) Sheet4 ここが、ご教示いただいて「成功」しているSheetです。
同じブック内で、Sheet1とSheet2 には、 D6:D25 H6:H25 L6:L15 の3種目の入力セル
ここでの「合格」判定欄には '=IF(AND(D4>=70,H4>=70,K4>=70),"合格","")
Sheet3には、D6:D25 I6:I15 の 2種目の入力セルがあります。
ここでの「合格」判定欄には '=IF(AND(D4>=70,H4>=70),"合格","")
◎ 新規ブック（Ｂ）Sheet1 Sheet2 Sheet3 には、各シート共通の（セル番地も）入力枠です。
入力するセル番地 C6:C15 F6:F25 I6:I25
ここでの「合格」判定欄には '=IF(K4="","",IF(K4>=210,"合格",""))
以上 よろしく お願いいたします。 （やま）
◎ 参考図書で見つけました。MsgBoxの関数では、定数で定義されているので「文字サイズの変更」 などは、 不可と勉強できました。User Form で作成の方法あり。従いまして、「Ｑ１」を削除させ てください。
「Ｑ２」についての、ご教示を尾根倍します。 （やま）
◎ 上段「Ｑ２」について
セル範囲の指定方法は、例 入力するセル番地 C6:C15 F6:F25 I6:I25 は ("C6:I25")でOkみたいです
◎ 最終的の質問と致しまして、
ここでの「合格」判定欄には '=IF(AND(D4>=70,H4>=70,K4>=70),"合格","") です。
ここでの「合格」判定欄には '=IF(K4="","",IF(K4>=210,"合格","")) です。
ここの「２例」の記述を Sheet Module の どこで「修正」すればよいのでしょうか？
ここでの「合格」判定欄には '=IF(AND(D4>=70,H4>=70),"合格","") これは「成功」の sheet4です。
以上 よろしく ご教示願います。 （やま）
遅くなってすいません。
シートごとに判定が異なるとのことですね。
数式で対応されているようですので、すべての解答欄が埋まった段階で数式が合格になっているかどうか
見に行けばよさそうです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rr As Range, cc As Range
Set rr = Range("C6:C15,F6:F25,I6:I25") '<--ここを変更
If Not Intersect(Target, rr) Is Nothing Then
If WorksheetFunction.CountA(rr) = rr.Cells.Count Then
If Range("F9").Value >= "合格" Then '<--ここも変更
Call Good_Melody
MsgBox "合格!"
Else
Call Bad_Melody
MsgBox "不合格...orz"
End If
Else
For Each cc In Intersect(Target, rr)
If cc.Offset(, 1).Value = "×" Then
Call Bad_Melody
End If
Next
End If
End If
End Sub
イベントマクロを上記に変更するとうまくいきますかね？
(ROUGE)
(ROUGE) さん：
◎ 何度も、的確なご教示をありがとうございます。 「各レベル」ごとに「種目数」や
「合格」の「判定基準」が異なりますが、すべてが「完璧」でした。 感謝です！
◎ 最後に、初心者で理解できるかどうか不安ですが、お尋ねします。
Dim rr As Range, cc As Range
rr と cc は、何かの省略というか、代用でしょうか？
If WorksheetFunction.CountA(rr) = rr.Cells.Count Then
Cells は カウンタ用変数を指定する、プロパティと参考書にありますが
ここで「指定されている定義」というのか、意味を ご教示ください。 （やま）
rr、ccともに変数ですよ。 予約語（Rangeとか、Cellsなど、もともと使われているもの）でなければ何でもOKです。 myRange とか、myCell などとされていることも多いと思います。 ご自分で分かりやすい変数にされると良いと思います。 σ(^-^;)はものぐさをしているため、そのような変数名にしています＾＾； ここで用いているCellsプロパティは、変数rrに格納されているセルの数を数えるために入れています。 (ROUGE)
◎ ありがとうございました。 マクロでは限界も有り、VBEの記述を少しでも使えるようになりたいと痛感しました。 また、老人パワー？で頑張ってまいります。 （やま）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.