#If Win64 Then
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As LongPtr, ByVal dwFlags As Long) As Boolean
#Else
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Boolean
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Private Sub CommandButton1_Click()
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
Dim Resim As Object
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Value <> "" Then
Call PlaySound("C:\Users\new\Documents\ses\" & Target.Value & ".wav", _
0, SND_ASYNC Or SND_FILENAME)
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".j")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".g")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".p")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".jp")
With Range("F" & Target.Row)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End If
End If
If Intersect(Target, [E1:E2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dinle yaz").Cells(Target.Row, "B")
End With
End If
If Intersect(Target, [G1:G2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dİnle yaz").Cells(Target.Row, "A")
End With
End Sub
Merhaba arkadaşlar. Ben en sonda yer alan hücre üzerine gelince B sütunundaki hücrelerde yazanlar denk gelen satırda E sütunundaki hücrede açıklama olarak çıksın kodunu tekrar ekleyip bu sefer A sütununda olanlar G sütununda denk gelen satırda gözüksün şeklinde eklemek istedim fakat beceremedim. yrdımcı olur musunuz?
Yani aslında
#If Win64 Then
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As LongPtr, ByVal dwFlags As Long) As Boolean
#Else
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Boolean
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Private Sub CommandButton1_Click()
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
Dim Resim As Object
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Value <> "" Then
Call PlaySound("C:\Users\new\Documents\ses\" & Target.Value & ".wav", _
0, SND_ASYNC Or SND_FILENAME)
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".j")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".g")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".p")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".jp")
With Range("F" & Target.Row)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End If
End If
If Intersect(Target, [E1:E2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dinle yaz").Cells(Target.Row, "B")
End With
Bu koda
If Intersect(Target, [G1:G2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dİnle yaz").Cells(Target.Row, "A")
Bunu da eklemek istiyorum.
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As LongPtr, ByVal dwFlags As Long) As Boolean
#Else
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Boolean
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Private Sub CommandButton1_Click()
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
Dim Resim As Object
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Value <> "" Then
Call PlaySound("C:\Users\new\Documents\ses\" & Target.Value & ".wav", _
0, SND_ASYNC Or SND_FILENAME)
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".j")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".g")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".p")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".jp")
With Range("F" & Target.Row)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End If
End If
If Intersect(Target, [E1:E2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dinle yaz").Cells(Target.Row, "B")
End With
End If
If Intersect(Target, [G1:G2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dİnle yaz").Cells(Target.Row, "A")
End With
End Sub
Merhaba arkadaşlar. Ben en sonda yer alan hücre üzerine gelince B sütunundaki hücrelerde yazanlar denk gelen satırda E sütunundaki hücrede açıklama olarak çıksın kodunu tekrar ekleyip bu sefer A sütununda olanlar G sütununda denk gelen satırda gözüksün şeklinde eklemek istedim fakat beceremedim. yrdımcı olur musunuz?
Yani aslında
#If Win64 Then
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As LongPtr, ByVal dwFlags As Long) As Boolean
#Else
Private Declare Function PlaySound Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Boolean
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Private Sub CommandButton1_Click()
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
Dim Resim As Object
If Selection.Count = 1 Then
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Value <> "" Then
Call PlaySound("C:\Users\new\Documents\ses\" & Target.Value & ".wav", _
0, SND_ASYNC Or SND_FILENAME)
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".j")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".g")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".p")
Set Resim = ActiveSheet.Pictures.Insert("C:\Users\new\Desktop\Kelime ezberi\" & Target.Value & ".jp")
With Range("F" & Target.Row)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
End If
End If
If Intersect(Target, [E1:E2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dinle yaz").Cells(Target.Row, "B")
End With
Bu koda
If Intersect(Target, [G1:G2132]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
With Selection.Validation
.Delete
.Add xlValidateInputOnly, xlValidAlertStop, xlBetween
.InputMessage = Sheets("dİnle yaz").Cells(Target.Row, "A")
Bunu da eklemek istiyorum.