같은 크루의 딱총님의 질문이다.
저 깊은곳에 박아놓았던 뻘짓(?) 유전자가 발동하여 만들어보았다.
자동연주랑 수동 연주가 있으니 심심한 분들은 한번씩 건드려 보시길 바란다.
자동연주는 본인이 유일하게 계이름을 아는 [인디언의 춤] 으로 구성하였다.
여기서 해당 음의 주파수를 가져왔다.
https://tomari.org/main/java/oto.html
Option Explicit
Private Declare PtrSafe Function Beep Lib "kernel32.dll" (ByVal dwFreq&, ByVal dwDuration&) As Long
Const 도 = 262
Const 도샵 = 277
Const 레 = 294
Const 레샵 = 311
Const 미 = 330
Const 파 = 349
Const 파샵 = 370
Const 솔 = 392
Const 솔샵 = 415
Const 라 = 440
Const 라샵 = 466
Const 시 = 493
* 32비트 에서는 Declare 뒤의 PtrSafe를 제외하고 실행하여야 한다.
Sub Piano(rw, clm)
If rw <= 2 Then '= 행번호가 2미만이면 ...피아노 영역만 이벤트 발생
Select Case clm '= 열번호가..
Case 5, 6 '= 5번(E열), 6번(F열)
Call Beep(도, 500) '= 음계 [도] 주파수 262와 음 길이는 0.5초 발생
Case 7
If rw = 1 Then
Call Beep(도샵, 500)
Else
Call Beep(도, 500)
End If
Case 8
If rw = 1 Then
Call Beep(도샵, 500)
Else
Call Beep(레, 500)
End If
Case 9
Call Beep(레, 500)
Case 10
코드의 반복으로 되어 있기 때문에 한번 보면 무슨 뜻인지 알것이다.
더보기
Option Explicit
Private Declare PtrSafe Function Beep Lib "kernel32.dll" (ByVal dwFreq&, ByVal dwDuration&) As Long
Const 도 = 262
Const 도샵 = 277
Const 레 = 294
Const 레샵 = 311
Const 미 = 330
Const 파 = 349
Const 파샵 = 370
Const 솔 = 392
Const 솔샵 = 415
Const 라 = 440
Const 라샵 = 466
Const 시 = 493
Sub Auto_piano()
Dim i&
Dim H, D
H = Array(미, 미, 레, 도, 미, 솔, 솔, 라, 솔, 미, 솔, 미, 미, 레, 도, 미, 솔, 솔, 미, 미, 레, 도, 도 * 2, 솔, 라, 솔, 라, 솔, 미, 솔, 도 * 2, 솔, 라, 솔, 미, 미, 레, 도)
D = Array(250, 250, 250, 250, 250, 250, 500, 250, 500, 250, 500, 250, 250, 250, 250, 250, 250, 500, 250, 500, 250, 500, 500, 250, 500, 250, 250, 500, 250, 500, 500, 250, 500, 250, 250, 500, 250, 250)
For i = 0 To UBound(H)
Beep H(i), D(i)
Next
MsgBox "훌륭한 연주군요"
End Sub
Sub Piano(rw, clm)
If rw <= 2 Then '= 행번호가 2미만이면 ...피아노 영역만 이벤트 발생
Select Case clm '= 열번호가..
Case 5, 6 '= 5번(E열), 6번(F열)
Call Beep(도, 500) '= 음계 [도] 주파수 262와 음 길이는 0.5초 발생
Case 7
If rw = 1 Then
Call Beep(도샵, 500)
Else
Call Beep(도, 500)
End If
Case 8
If rw = 1 Then
Call Beep(도샵, 500)
Else
Call Beep(레, 500)
End If
Case 9
Call Beep(레, 500)
Case 10
If rw = 1 Then
Call Beep(레샵, 500)
Else
Call Beep(레, 500)
End If
Case 11
If rw = 1 Then
Call Beep(레샵, 500)
Else
Call Beep(미, 500)
End If
Case 12, 13
Call Beep(미, 500)
Case 14, 15
Call Beep(파, 500)
Case 16
If rw = 1 Then
Call Beep(파샵, 500)
Else
Call Beep(파, 500)
End If
Case 17
If rw = 1 Then
Call Beep(파샵, 500)
Else
Call Beep(솔, 500)
End If
Case 18
Call Beep(솔, 500)
Case 19
If rw = 1 Then
Call Beep(솔샵, 500)
Else
Call Beep(솔, 500)
End If
Case 20
If rw = 1 Then
Call Beep(솔샵, 500)
Else
Call Beep(라, 500)
End If
Case 21
Call Beep(라, 500)
Case 22
If rw = 1 Then
Call Beep(라샵, 500)
Else
Call Beep(라, 500)
End If
Case 23
If rw = 1 Then
Call Beep(라샵, 500)
Else
Call Beep(시, 500)
End If
Case 24, 25
Call Beep(시, 500)
Case 26, 27
Call Beep(도 * 2, 500)
Case 28
If rw = 1 Then
Call Beep(도샵 * 2, 500)
Else
Call Beep(도 * 2, 500)
End If
Case 29
If rw = 1 Then
Call Beep(도샵 * 2, 500)
Else
Call Beep(레 * 2, 500)
End If
Case 30
Call Beep(레 * 2, 500)
Case 31
If rw = 1 Then
Call Beep(레샵 * 2, 500)
Else
Call Beep(레 * 2, 500)
End If
Case 32
If rw = 1 Then
Call Beep(레샵 * 2, 500)
Else
Call Beep(미 * 2, 500)
End If
Case 33, 34
Call Beep(미 * 2, 500)
Case 35, 36
Call Beep(파 * 2, 500)
Case 37
If rw = 1 Then
Call Beep(파샵 * 2, 500)
Else
Call Beep(파 * 2, 500)
End If
Case 38
If rw = 1 Then
Call Beep(파샵 * 2, 500)
Else
Call Beep(솔 * 2, 500)
End If
Case 39
Call Beep(솔 * 2, 500)
Case 40
If rw = 1 Then
Call Beep(솔샵 * 2, 500)
Else
Call Beep(솔 * 2, 500)
End If
Case 41
If rw = 1 Then
Call Beep(솔샵 * 2, 500)
Else
Call Beep(라 * 2, 500)
End If
Case 42
Call Beep(라 * 2, 500)
Case 43
If rw = 1 Then
Call Beep(라샵 * 2, 500)
Else
Call Beep(라 * 2, 500)
End If
Case 44
If rw = 1 Then
Call Beep(라샵 * 2, 500)
Else
Call Beep(시 * 2, 500)
End If
Case 45, 46
Call Beep(시 * 2, 500)
End Select
End If
End Sub
'VBA' 카테고리의 다른 글
[VBA] 만능폴더 만들기 (0) | 2023.04.18 |
---|---|
[VBA] 구글번역기 beta (0) | 2023.03.24 |
[VBA] 네이버 영어사전 LV4.(댓글 요청) (5) | 2022.12.31 |
[셀레니움]#3_네이버날씨 크롤링 (0) | 2022.12.27 |
[VBA] For Each & Areas 를 이용한 셀 조작하기 (0) | 2022.12.25 |
댓글