■
Piyanomuzu hazırlamak için gereken kodlar:
Declare Function GetTickCount& Lib "kernel32" ()
Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub sil()
Dim Sh As Worksheet, sha As Shape: Set Sh = ActiveSheet
For Each sha In Sh.Shapes
If sha.name Like "Button_*" Then sha.Delete
Next sha
End Sub
Sub olustur()
mr = "qazwsxedcrfvtgbyhnujmik,ol.p;/['"
sil
pos = 70: Application.ScreenUpdating = False
For i = 1 To Len(mr)
letter = Mid(mr, i, 1)
'Select Case (i + 9) Mod 12
Select Case i Mod 12
Case 2, 4, 7, 9, 11
Siyah pos + 1 - Range("a:a").Width / 2, letter
Case Else
Beyaz pos, letter
pos = pos + Range("b:b").Width + 2
End Select
Next
[a1].Select
End Sub
Sub Siyah(ByVal X As Long, ByVal name As String)
With aralik([a1:a9], vbBlack, "", "Music")
.name = "Button_" & name
.Left = X: .Top = 60
.ZOrder msoBringToFront
End With
End Sub
Sub Beyaz(ByVal X As Long, ByVal name As String)
With aralik([b1:b14], vbWhite, "", "Music")
.name = "Button_" & name
.Left = X: .Top = 60
.ZOrder msoSendToBack
End With
End Sub
Sub melodi1(): Speed = 150
beeps "5 5 3jnybt tybtftdx2d", Speed: beeps "5 5 3jnybt tybtftdx2d", Speed
beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf2t", Speed: beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf3 yb2t", Speed
End Sub
Sub melodi2(): Speed = 250
beeps "jny3b3t5 5 jny3y3b 5 5 bynk2m5 bynk2m j2b2 n3y", Speed: beeps "5 5 5 jny3b3t5 5 jny3y3b 5 5 bynk2m5 bynk2m j2b2 y3t", Speed
beeps "5 5 5 ff3y5 yy2yyy2yby2b4t", Speed: beeps "5 5 5 ff2y5 tby tby nj3m", Speed
End Sub
Private Sub Music()
On Error Resume Next
Dim Sh As Worksheet: Set Sh = ActiveSheet
beeps Split(Sh.Shapes(Application.Caller).name, "_")(1)
End Sub
Sub beeps(melodi, Optional ByVal BeepTime As Integer = 200): mr = "qazwsxedcrfvtgbyhnujmik,ol.p;/['"
On Error Resume Next: Dim sha As Shape, LastColor As Long
For i = 1 To Len(melodi)
DoEvents
nextlen = 1: letter = Mid$(melodi, i, 1)
nota = InStr(1, mr, letter)
If IsNumeric(letter) And letter > 0 Then nextlen = letter: i = i + 1: nota = InStr(1, mr, Mid$(melodi, i, 1))
If nota > 0 Then
If Len(melodi) > 1 Then
Set sha = ActiveSheet.Shapes("Button_" & Mid$(melodi, i, 1))
LastColor = sha.Fill.ForeColor.RGB
sha.Fill.ForeColor.RGB = vbRed: DoEvents
sha.Top = sha.Top + 2: sha.Left = sha.Left + 2: DoEvents
End If
tone = 220 * (2 ^ ((nota - 1) / 12)): a = Beep(tone, nextlen * BeepTime)
Else
Set sha = Nothing
a = Beep(30000, nextlen * BeepTime / 5)
End If
If Not sha Is Nothing Then
sha.Fill.ForeColor.RGB = LastColor
sha.Top = sha.Top - 2: sha.Left = sha.Left - 2
End If
Next: [a1].Select
End Sub
Function aralik(ByRef ra As Range, ByVal Button_color As Long, ByVal txt As String, Optional ByVal MacroName As String = "") As Shape
On Error Resume Next: Err.Clear
w = ra.Width: h = ra.Height: w = IIf(w > 10, w, 50): h = IIf(h > 10, h, 50)
l = ra.Left: t = ra.Top:
Dim sha As Shape: Set sha = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, l, t, w, h)
With sha
.Fill.Visible = msoTrue: .Fill.Solid: .Fill.ForeColor.RGB = Button_color: .Fill.Transparency = 4
.Fill.BackColor.RGB = vbWhite: .Fill.TwoColorGradient msoGradientFromCenter, 2
.Adjustments.Item(1) = 0.16: .Placement = xlFreeFloating: .OLEFormat.Object.PrintObject = False
With .TextFrame
.Characters.Text = txt
With .Characters.Font
.Size = IIf(h >= 16, 10, 8): .Bold = True: .name = "Arial Narrow": .name = "Arial"
End With
.HorizontalAlignment = xlCenter: .VerticalAlignment = xlVAlignCenter
End With
.OnAction = MacroName
End With
Set aralik = sha
End Function