Excel'de Piyano Çalmak

Anonim

(@Anonim)

Gönderiler: 0

Konu başlatıcı

Excel'de Piyano çalabilir ve kendi bestelerinizi yapabilirsiniz...

[img]

[/img]

■ 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

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

Hoşça kalın ! --)(

Gönderildi : 16/11/2013 15:00

Rıza ŞAHAN

(@riza-sahan)

Gönderiler: 18032

_

Eğlenceli bir paylaşım :))

1984 doğumluyum. 4 yaşından bu yana İstanbul’da yaşıyorum. Sırası ile aşağıdaki okullarda eğitim gördüm. Paşaköy ilkokulu (1990-1995) Kartal Zekeriyya Güçer İlköğretim Okulu(1995-1998) Ümraniye Teknik ve Endüstri Meslek Lisesi Bilgisayar Bölümü(1998-2001) Kocaeli Üniversitesi Bilgisayar Programcılığı(2002-2004) Anadolu Ünv. İşletme Fakültesi(2006-2009) Lise yıllarından sonra bir bilgisayar firmasının teknik servisinde mesleğe merhaba dedim. Outsource olarak Citibank ytl ve bina taşınma projesinde yer alarak 8 ay görev yaptım. Bu görevden sonra şu an çalışmakta olduğum yerde bilgi işlem sorumlusu olarak göreve başladım ve 18 yıldır görevimin başındayım.

Gönderildi : 17/11/2013 00:06