HATA YARDIM TALEBİ

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,562
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

64 bit excel için api deklarasyon ptrsafe hatası almışsınız.

Forumda ptrsafe ifadesi ile arama yapabilirsiniz. Ben yapamam derseniz dosyanızı paylaşmanızı öneririm.
 
B

bydogannn67

Altın Üye
Katılım
6 Ocak 2016
Mesajlar
222
Excel Vers. ve Dili
2010 türkçe
Altın Üyelik Bitiş Tarihi
03-09-2029
Hocam Dosyayı yukleyemıyorum ama kod bu şekilde

Kod: 
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Const EVN_TASINMA = &H2 '
Private Const EVN_BOYUTLANMA = &H1 '
Private Const EVN_STIL = (-20) '
Private Const EVN_UST = 0 '
Private Const EVN_AKTIFDEGIL = &H10 '
Private Const EVN_GIZLE = &H80 '
Private Const EVN_GOSTER = &H40 '
Private Const EVN_PENCERE = &H40000 '
Private Const EVN_STILI = (-16) '
Private Const EVN_KUCULTBUTON = &H20000 '
Private Const EVN_BUYUTBUTON = &H10000 '
Private Const EVN_DEGIS = &H20 '
Dim hwnd As Long, WSTILI As Long, SONUC As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public kontrol As Boolean
Function KucultButonuEkle() As Long
    hwnd = GetActiveWindow
    Call SetWindowLong(hwnd, EVN_STILI, _
        GetWindowLong(hwnd, EVN_STILI) Or EVN_KUCULTBUTON)
    Call SetWindowPos(hwnd, 0, 0, 0, 0, 0, _
        EVN_DEGIS Or EVN_TASINMA Or EVN_BOYUTLANMA)
End Function
Function BuyutButonuEkle() As Long
    hwnd = GetActiveWindow
    Call SetWindowLong(hwnd, EVN_STILI, _
        GetWindowLong(hwnd, EVN_STILI) Or EVN_BUYUTBUTON)
    Call SetWindowPos(hwnd, 0, 0, 0, 0, 0, _
        EVN_DEGIS Or EVN_TASINMA Or EVN_BOYUTLANMA)
End Function
Function GorevCubugundaGoster(Formum) As Long
    hwnd = FindWindow(vbNullString, Formum.Caption)
    WSTILI = GetWindowLong(hwnd, EVN_STIL)
    WSTILI = WSTILI Or EVN_PENCERE
    SONUC = SetWindowPos(hwnd, EVN_UST, 0, 0, 0, 0, _
        EVN_TASINMA Or EVN_BOYUTLANMA Or EVN_AKTIFDEGIL Or EVN_GIZLE)
        SONUC = SetWindowLong(hwnd, EVN_STIL, WSTILI)
        SONUC = SetWindowPos(hwnd, EVN_UST, 0, 0, 0, 0, _
        EVN_TASINMA Or EVN_BOYUTLANMA Or EVN_AKTIFDEGIL Or EVN_GOSTER)
End Function
Private Sub UserForm_Activate()
ThisWorkbook.Activate
Call GorevCubugundaGoster(Me)
KucultButonuEkle
End Sub
Private Sub CommandButton24_Click()
ThisWorkbook.Activate
Sheets("FİRMA MAİL LİSTESİ").Select
Application.Visible = True
Unload FİRMAMAİL
With Application
        .WindowState = xlNormal
        .Width = 900
        .Height = 500
        .Left = 0
        .Top = 0
    End With
End Sub

Private Sub CommandButton26_Click()
ThisWorkbook.Activate
Application.ScreenUpdating = False
If ListBox1.ListIndex < 0 Or TextBox1 = "  Firma İsmi" Then
MsgBox "Firma İsmi Girmediniz", vbCritical
Exit Sub
End If
If TextBox1 = "" Then MsgBox "FİRMA İSMİ GİRİNİZ": Exit Sub
Set s1 = Sheets("FİRMA MAİL LİSTESİ")
x = s1.Cells(Rows.Count, "B").End(3).Row
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
Set R = s1.Range("B1:B" & x).Find(Trim(ListBox1.List(i, 1)), , xlValues, xlPart, , , False)
 If Not R Is Nothing Then
 s1.Cells(R.Row, "B") = TextBox1.Value
 ListBox1.Clear
UserForm_Initialize
 MsgBox R.Value & vbCrLf & Chr(10) & "Firma İsmi Değiştirilmiştir...", vbInformation
TextBox1 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox3 = Empty
 Exit For
 Else
 MsgBox "Firma İsmi bulunamadığından; Değiştirilemedi"
 End If
 End If
Next i
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton28_Click()
Dim ad As String, s As Byte
Dim sat, son, deg, k As Integer
Dim sayfa As String
ThisWorkbook.Activate
Application.ScreenUpdating = False
Sheets("FİRMA MAİL LİSTESİ").Select
'mükerrer kontrol
For sat = 2 To Cells(65536, "b").End(xlUp).Row
If Cells(sat, "b") = TextBox1 Then
    MsgBox "[ " & TextBox1.Text & " ] İsimi zaten kayıtlı. " _
    & vbLf & "" & vbLf _
    & vbLf & "Bu kayıt  kaydedilmedi." & vbLf _
    & vbLf, vbCritical, "UYARI"
TextBox1 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox3 = Empty
Exit Sub: End If: Next
'*****verigir
If TextBox1 = "" Then
    MsgBox " Firma İsmi Girmelisiniz ", vbInformation
    TextBox1.SetFocus
Exit Sub
End If

If TextBox5 = "" Then
    MsgBox "Mail Adresi Girmediniz", vbInformation
    TextBox5.SetFocus
Exit Sub
End If
son = Sheets("FİRMA MAİL LİSTESİ").Cells(65536, "b").End(xlUp).Row + 1
Sheets("FİRMA MAİL LİSTESİ").Cells(son, "b") = TextBox1.Value
Sheets("FİRMA MAİL LİSTESİ").Cells(son, "c") = TextBox5
Sheets("FİRMA MAİL LİSTESİ").Cells(son, "d") = TextBox4
[a2:a65536] = Empty
sonsat = Cells(65536, "b").End(xlUp).Row
ActiveWorkbook.Worksheets("FİRMA MAİL LİSTESİ").Range("B2:E" & sonsat).Sort Range("B2")
 Range("A2").FormulaR1C1 = "1"
 Range("A2").AutoFill Destination:=Range("A2:A" & Cells(Rows.Count, 2).End(3).Row), Type:=xlFillSeries
ListBox1.Clear
UserForm_Initialize
Label1 = Sayfa8.Range("a65536").End(3).Row - 1
MsgBox "KAYIT İŞLEMİ YAPILMIŞTIR.", vbInformation
TextBox1 = Empty
TextBox4 = Empty
TextBox5 = Empty
Application.ScreenUpdating = True
End Sub


Private Sub CommandButton22_Click()
ThisWorkbook.Activate
Sheets("GİRİŞ").Select
Unload FİRMAMAİL
ANASAYFA.Show
End Sub
Private Sub CommandButton23_Click()
 ActiveWorkbook.Save
End Sub
Private Sub CommandButton25_Click()
ThisWorkbook.Activate
Application.ScreenUpdating = False
If ListBox1.ListIndex < 0 Or TextBox5 = "  Firma Mail Adresi" Then
MsgBox "Mail Adresi Girmediniz", vbCritical
Exit Sub
End If
If TextBox1 = "" Then MsgBox "FİRMA İSMİ GİRİNİZ": Exit Sub
Set s1 = Sheets("FİRMA MAİL LİSTESİ")
x = s1.Cells(Rows.Count, "B").End(3).Row
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
 Set R = s1.Range("B1:B" & x).Find(Trim(ListBox1.List(i, 1)), , xlValues, xlPart, , , False)
 If Not R Is Nothing Then
 s1.Cells(R.Row, "C") = TextBox5.Value
 ListBox1.Clear
UserForm_Initialize
 MsgBox R.Value & vbCrLf & Chr(10) & "Mail Adresi Girilmiştir...", vbInformation
 Exit For
 Else
  MsgBox "Mail Adresi Firma İsmi Bulunamadığı İçin Girilememiştir...", vbInformation
 End If
 End If
Next i
TextBox1 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox3 = Empty
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton6_Click()
ThisWorkbook.Activate
Application.ScreenUpdating = False
If ListBox1.ListIndex < 0 Or TextBox4 = "  Firma İlgili Kişi" Then
MsgBox "İlgili Kişi Bilgisi Girmediniz", vbCritical
Exit Sub
End If
If TextBox1 = "" Then MsgBox "FİRMA İSMİ GİRİNİZ": Exit Sub
Set s1 = Sheets("FİRMA MAİL LİSTESİ")
x = s1.Cells(Rows.Count, "B").End(3).Row
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
 Set R = s1.Range("B1:B" & x).Find(Trim(ListBox1.List(i, 1)), , xlValues, xlPart, , , False)
 If Not R Is Nothing Then
 s1.Cells(R.Row, "D") = TextBox4.Value
ListBox1.Clear
UserForm_Initialize
MsgBox R.Value & vbCrLf & Chr(10) & "İlgili Kişi Bilgisi Girilmiştir...", vbInformation
Exit For
Else
MsgBox "İlgili Kişi Bilgisi Firma İsmi Bulunamadığı İçin Girilememiştir...", vbInformation
 End If
 End If
Next i
TextBox1 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox3 = Empty
Application.ScreenUpdating = True
End Sub

Sub temiz()
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next i
End Sub



Private Sub CommandButton30_Click()
ThisWorkbook.Activate
Application.DisplayAlerts = False
Sheets("FİRMA MAİL LİSTESİ").Select
Set s1 = Sheets("FİRMA MAİL LİSTESİ")
x = s1.Cells(Rows.Count, "B").End(3).Row
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) = True Then
s1.Cells(i + 2, "B").EntireRow.Delete
MsgBox ListBox1.List(i, 1) & vbCrLf & Chr(10) & _
"SİLME İŞLEMİ YAPILMIŞTIR...", vbInformation
 v = 1
 End If
Next i
If v = Empty Then
MsgBox "Firma Seçmediniz", vbCritical:
Exit Sub
Else
s1.Range("A1:A" & Rows.Count) = Empty
s1.[A2] = 1
s1.[A2].AutoFill Destination:=Range("A2:A" & ListBox1.ListCount + 1), Type:=xlFillSeries
Label1 = Sayfa8.Range("a65536").End(3).Row - 2
End If
ListBox1.Clear
UserForm_Initialize
TextBox1 = Empty
TextBox4 = Empty
TextBox5 = Empty
Application.DisplayAlerts = True
End Sub
Private Sub TextBox3_Change()
Set s1 = Sheets("FİRMA MAİL LİSTESİ")
On Error Resume Next
TextBox3 = Evaluate("=büyükharf(""" & TextBox3 & """)")
TextBox3 = Evaluate("=upper(""" & TextBox3 & """)")
ListBox1.Clear
Dim bul As Range
b = 0
Set bul = s1.Range("B1:B65000").Find(TextBox3 & "*", , xlValues, xlPart, , , False)
If Not bul Is Nothing Then
    Application.EnableEvents = False
    fg = bul.Address
    Do
If LCase(bul) Like LCase(TextBox3 & "*") Then
ListBox1.AddItem s1.Cells(bul.Row, "A")
ListBox1.List(b, 1) = s1.Cells(bul.Row, "B")
ListBox1.List(b, 2) = s1.Cells(bul.Row, "C")
ListBox1.List(b, 3) = s1.Cells(bul.Row, "D")
b = b + 1
End If
If bul Is Nothing Then Exit Do
 Set bul = s1.Range("B2:B65000").FindNext(bul)
    Loop While Not bul Is Nothing And bul.Address <> fg
TextBox1 = Empty
TextBox4 = Empty
TextBox5 = Empty
    Application.EnableEvents = True
End If
End Sub
Private Sub ListBox1_Change()
TextBox1 = "  Firma İsmi"
TextBox5 = "  Firma Mail Adresi"
TextBox4 = "  Firma İlgili Kişi"
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
b = b + 1
B2 = ListBox1.ListIndex
End If
Next i
If b = 1 Then
TextBox1 = ListBox1.List(B2, 1)
TextBox5 = ListBox1.List(B2, 2)
TextBox4 = ListBox1.List(B2, 3)
End If
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.ColumnCount = 4
.ColumnWidths = "25;260;335;50"
.ListStyle = 1
.MultiSelect = 1
End With
Set s1 = Sheets("FİRMA MAİL LİSTESİ")
b = 0
For a = 2 To s1.[b65536].End(3).Row
ListBox1.AddItem s1.Cells(a, "A")
ListBox1.List(b, 1) = s1.Cells(a, "B")
ListBox1.List(b, 2) = s1.Cells(a, "C")
ListBox1.List(b, 3) = s1.Cells(a, "D")
b = b + 1
Next
Label1 = Sayfa8.Range("a65536").End(3).Row - 2
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,562
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Kod bölümünü açınca paylaştığınız kodların olduğu bölüme ulaşın.
CTRL+H dedikten sonra aranan bölümüne (ilk kutucuğa) Private Declare Function ifadesini yazınız.
Aynı ekranda ikinci kutucuğa Private Declare PtrSafe Function ifadesini yazarak tümünü değiştir yapınız.

Sonra kodu tekrar deneyin. Yine hata verirse farklı önerilerde bulunuruz.

Ayrıca linkte kullandığınız API'lerle ilgili bahsi geçen düzenlemelerin paylaşıldığı linki inceleyerek çözüme gidebilirsiniz.

Declaring API functions for 64 bit Office (and Mac Office)

JKP Application Development Services, Microsoft Office Application Development
jkp-ads.com
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst