Yardım! "EKLE" komut butonuna bastığımda EXCEL kendini kapatıyor.

emreeken · 3 Nisan 2024

Merhaba Değerli Hocalarım.
Yeni Ürün Giriş Ekle Kısmına giriyoruz. Burada ilgili alanları doldurup ekle dediğimde excel kendini kapatıyor ve yeni boş sayfa açıyor.
Excel 64 bitte bu problemi alıyorum. 32 bit excelde düzgün bir şekilde çalıyor. Kontrol edebilir misiniz, bir türlü hatayı gideremedim.
Ekle butonun kodlarını da ekliyorum.
Link aşağıdadır.

Tabildot_Son23456.xls dosyasını indir - download

Tabildot_Son23456.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s2.dosya.tc

Kod:

Private Sub kilereekle_Click()

Set KL = Sheets("Kiler")
Set ANM = Sheets("Ana_Menü")
Set ÜF = Sheets("Ürün_Fiyat")

On Error Resume Next
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx KISITLAMALAR BÖLÜMÜ

If ürünadıgrşyeni = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" ÜRÜN ADI "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If

If firmaadı = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" FİRMA ADI "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If

If faturano = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" FATURA NO "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If

If birimigrş = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" BİRİMİNİ "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If


If kdvgrş = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" KDV ORANINI "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If

If gelişhariçgrş = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" ÜRÜN KDV HARİÇ GELİŞ FİYATINI "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If

If miktarıgrş = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" ÜRÜN MİKTARI "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If


If gelişdahilgrş = "" Then
MsgBox "EKSİK BİLGİ GİRİŞİ !" & vbCrLf & "LÜTFEN "" ÜRÜN KDV DAHİL GELİŞ FİYATINI "" GİRİNİZ.", vbExclamation, "Sayın   " & Application.UserName
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub: End If

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx KOD AKTARMA BÖLÜMÜ

If WorksheetFunction.CountIf(ÜF.[E:E], ürünadıgrşyeni & " " & cbTarih1) > 0 Then
MsgBox "DİKKAT !!!" & vbCrLf & "YAZMIŞ OLDUĞUNUZ ÜRÜN ""ÜRÜN FİYAT"" SAYFASINDA MEVCUTTUR." & vbCrLf & " LÜTFEN ANAMENÜ ÜZERİNDEN NORMAL GİRİŞ  YAPINIZ .", vbInformation, Application.UserName
Unload Me
UserForm1.Show
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing
Exit Sub
Else


cevap = MsgBox("ÜRÜN İSMİ  VE DİĞER BİLGİLERİ KONTROL ETTİNİZMİ ?", vbYesNo, Application.UserName)
If cevap = vbYes Then

Excel.Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


son = KL.Cells(65536, "C").End(xlUp).Row + 1 'KİLER SAYFASINA ÜRÜN EKLER

KL.Cells(son + 6, "C") = WorksheetFunction.Max(KL.[C:C]) + 1

KL.Cells(son + 5, "P") = cbTarih1
KL.Cells(son + 5, "I") = birimigrş 'BİRİMİ
KL.Cells(son + 5, "J") = CDbl(kdvgrş) 'KDV
KL.Cells(son + 5, "G") = CDbl(miktarıgrş) 'MİKTAR
KL.Cells(son + 5, "K") = CDbl(gelişhariçgrş) 'GELİŞ FİYATI KDV HARİÇ
KL.Cells(son + 5, "L") = ANM.[AM59] 'GELİŞ FİYATI KDV DAHİL
KL.Cells(son + 5, "M") = ANM.[AM60] 'GELİŞ FİYATI TOPLAM KDV DAHİL
KL.Cells(son + 5, "D") = cbTarih2 'FATURA TARİHİ
KL.Cells(son + 5, "Q") = CDbl(faturano) 'FATURA NO
KL.Cells(son + 5, "R") = firmaadı 'FİRMA ADI
KL.Cells(son + 5, "O") = "G"
KL.Cells(son + 5, "E") = ürünadıgrşyeni 'MALIN ADI
KL.Cells(son + 5, "F") = ürünadıgrşyeni & " " & cbTarih1 'MALIN ADI TARİHLİ

KL.Range("D6:R65536").Sort KL.Range("D6") ' SÜZ
KL.Range("C6:C65536").Sort KL.Range("C6") ' SÜZ

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

SON_SATIR = ÜF.[C65536].End(3).Row + 1 ' ÜRÜN FİYAT SAYFASINA YENİ ÜRÜN VEYA ANLAŞMA TARİHİ YENİ ÜRÜN EKLER
  
ÜF.Cells(SON_SATIR, "C") = WorksheetFunction.Max(ÜF.[C:C]) + 1


ÜF.Cells(SON_SATIR, "F") = birimigrş  'BİRİMİ
ÜF.Cells(SON_SATIR, "E") = ürünadıgrşyeni & " " & cbTarih1  'MALIN TARİHLİ ADI
ÜF.Cells(SON_SATIR, "G") = cbTarih2  'ALIŞ TARİH
ÜF.Cells(SON_SATIR, "H") = cbTarih1  'AKTİF ANLAŞMA TARİHİ
ÜF.Cells(SON_SATIR, "I") = CDbl(gelişhariçgrş)  'GELİŞ FİYATI KDV HARİÇ

ÜF.Cells(SON_SATIR, "J") = ANM.[AM59] 'GELİŞ FİYATI KDV DAHİL
ÜF.Cells(SON_SATIR, "K") = CDbl(kdvgrş)  'KDV
ÜF.Cells(SON_SATIR, "D") = ürünadıgrşyeni  'MALIN ADI
ÜF.Cells(SON_SATIR, "O") = CDbl(miktarıgrş) 'MİKTAR
ÜF.Cells(SON_SATIR, "P") = ANM.[AM60] 'TOPLAM TUTAR
ÜF.Cells(SON_SATIR, "Q") = CDbl(faturano) 'FATURA NO
ÜF.Cells(SON_SATIR, "R") = firmaadı 'FİRMA ADI


ÜF.Range("D6:R65536").Sort ÜF.Range("D6") 'SÜZ
ÜF.Range("C6:C65536").Sort ÜF.Range("C6") 'SÜZ

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End If
End If

ürünadıgrşyeni = Empty
birimigrş = Empty
kdvgrş = Empty
gelişhariçgrş = Empty
miktarıgrş = Empty
UserForm1.kilermevcut = KL.[M3]
UserForm1.kilermevcut = Format(UserForm1.kilermevcut, "#,##0.00")

Dim b As Long
Set KL = Sheets("Kiler")
For b = 6 To KL.[E65536].End(3).Row
If Application.WorksheetFunction.CountIf(KL.Range("E6:E" & b), KL.Cells(b, "E")) = 1 Then
ürünadıgrşyeni.AddItem KL.Cells(b, "E")
End If
Next b

Dim I As Long
For I = 6 To KL.[R65536].End(3).Row
If Application.WorksheetFunction.CountIf(KL.Range("R6:R" & I), KL.Cells(I, "R")) = 1 Then
UserForm1.firmaadı.AddItem KL.Cells(I, "R")
End If
Next I
    Set ÜF = Sheets("Ürün_Fiyat")
    Set KY = Sheets("Kaynak")

    KY.[AD4:AI15000].ClearContents
    Satır = 5
    Set Bul = ÜF.[H:H].Find(CDate(cbTarih1))
    If Not Bul Is Nothing Then
    adres = Bul.Address
    Do
    If ÜF.Cells(Bul.Row, "H") = cbTarih1 Then
  
    KY.Cells(Satır, "AI") = ÜF.Cells(Bul.Row, "H") 'ANLAŞMA TARİHİ
    KY.Cells(Satır, "AD") = ÜF.Cells(Bul.Row, "D") 'MALIN ADI
    KY.Cells(Satır, "AE") = ÜF.Cells(Bul.Row, "F") 'BİRİMİ
    KY.Cells(Satır, "AF") = ÜF.Cells(Bul.Row, "K") 'KDV
    KY.Cells(Satır, "AG") = ÜF.Cells(Bul.Row, "I") 'GELİŞ HARİÇ
    KY.Cells(Satır, "AH") = ÜF.Cells(Bul.Row, "J") 'GELİŞ DAHİL
          
  
  
  
    Satır = Satır + 1
  
    End If
    Set Bul = ÜF.[H:H].FindNext(Bul)
    Loop While Not Bul Is Nothing And Bul.Address <> adres

    End If
  
  

  


MsgBox "YENİ ÜRÜN GİRİŞ KAYDI BAŞARIYLA YAPILMIŞTR.", vbInformation, "Sayın   " & Application.UserName
ExecuteExcel4Macro ("SOUND.PLAY(, ""C:\Windows\Media\Windows XP Yazdırma tamam.wav"")")

Set Bul = Nothing
Set KG = Nothing
Set KL = Nothing
Set ANM = Nothing
Set ÜF = Nothing

End Sub

emreeken · 4 Nisan 2024

bu konu hakkında yardım bekliyorum.

Korhan Ayhan · 4 Nisan 2024

Merhaba,

Bilgisayarımdaki Türkçe karakter sorunundan dolayı dosyanızı inceleyemedim.

Ama sorunu belki şu şekilde tespit edebilirsiniz.

VBA kod editörünü açtıktan sonra Userform2 ismini çift tıklayıp ekrana açın.
Form üzerindeki EKLE butonuna çift tıklayıp kod penceresine ulaşın.

Aşağıdaki satırın üstüne mouse ile bir kez tıklayın.

Set KL = Sheets("Kiler")

Yani mouse cursor bu satır içinde olsun.
Sonra F9 tuşuna basıp bu satır için durdurma noktası oluşturun.
Sonrasında formu kayıt girmek için açıp giriş işlemlerini tamamlayıp EKLE butonuna tıklayın.
Bu aşamada kod F9 ile işaretlediğiniz satırda duracaktır. Sonrasında F8 ile kodu adım adım çalıştırıp hata veren satırı/satırları tespit edebilirsiniz.

Not: 4. satırda bulunan On Error Resume Next komutunun başına tek tırnak ekleyerek pasif hale getirdikten sonra önerimi deneyiniz.

emreeken · 4 Nisan 2024

Korhan Ayhan' Alıntı:
Merhaba,

Bilgisayarımdaki Türkçe karakter sorunundan dolayı dosyanızı inceleyemedim.

Ama sorunu belki şu şekilde tespit edebilirsiniz.

VBA kod editörünü açtıktan sonra Userform2 ismini çift tıklayıp ekrana açın.
Form üzerindeki EKLE butonuna çift tıklayıp kod penceresine ulaşın.

Aşağıdaki satırın üstüne mouse ile bir kez tıklayın.

Set KL = Sheets("Kiler")

Yani mouse cursor bu satır içinde olsun.
Sonra F9 tuşuna basıp bu satır için durdurma noktası oluşturun.
Sonrasında formu kayıt girmek için açıp giriş işlemlerini tamamlayıp EKLE butonuna tıklayın.
Bu aşamada kod F9 ile işaretlediğiniz satırda duracaktır. Sonrasında F8 ile kodu adım adım çalıştırıp hata veren satırı/satırları tespit edebilirsiniz.

Not: 4. satırda bulunan On Error Resume Next komutunun başına tek tırnak ekleyerek pasif hale getirdikten sonra önerimi deneyiniz.

Merhaba değerli hocam.
dediklerinizi yaptım. F8 e basarak buraya kadar geliyor ve burada sürekli tekrar ediyor. Aşağı iniyor tekrar yukarı çıkıp tekrar başlıyor.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D

,E:E,R:R]) Is Nothing Then Exit Sub
Target.Value = LCase(Replace(Replace(Target.Value, "I", "ı"), "İ", "i"))
End Sub

emreeken · 4 Nisan 2024

emreeken' Alıntı:
Merhaba değerli hocam.
dediklerinizi yaptım. F8 e basarak buraya kadar geliyor ve burada sürekli tekrar ediyor. Aşağı iniyor tekrar yukarı çıkıp tekrar başlıyor.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D,E:E,R:R]) Is Nothing Then Exit Sub
Target.Value = LCase(Replace(Replace(Target.Value, "I", "ı"), "İ", "i"))
End Sub

Hocam bu kodu sildim hata vermedi. Burda ne gibi bir hata var acaba ?
64 Bitte çalışmıyor fakat 32 bit excelde çalışıyor

Korhan Ayhan · 4 Nisan 2024

Durum anlaşıldı..

Aşağıdaki örnek kod yapısını kendi EKLE butonunuza uygulayıp deneyiniz.

C++:

Option Explicit

Sub EKLE()
    Application.EnableEvents = False
    Rem Kodlarınız...
    Rem Kodlarınız...
    Rem Kodlarınız...
    Rem Kodlarınız...
    Rem Kodlarınız...
    Application.EnableEvents = True
End Sub

emreeken · 4 Nisan 2024

Korhan Ayhan' Alıntı:
Durum anlaşıldı..

Aşağıdaki örnek kod yapısını kendi EKLE butonunuza uygulayıp deneyiniz.

C++:

Option Explicit Sub EKLE() Application.EnableEvents = False Rem Kodlarınız... Rem Kodlarınız... Rem Kodlarınız... Rem Kodlarınız... Rem Kodlarınız... Application.EnableEvents = True End Sub

Tşkler hocam fakat rem kodlarınız yazdığınız yere ne yazcam acaba mazur görün beni yeniyim

Korhan Ayhan · 4 Nisan 2024

Aşağıdaki işlemi benim örnek olarak verdiğim kod bloğundaki gibi uygulayınız..

Daha kısacası;

Alttaki satırı EKLE butonu ilk satırına ekleyiniz.

Application.EnableEvents = False

Alttaki satırı EKLE butonu son satırına ekleyiniz.

Application.EnableEvents = True

emreeken · 4 Nisan 2024

Korhan Ayhan' Alıntı:
Aşağıdaki işlemi benim örnek olarak verdiğim kod bloğundaki gibi uygulayınız..

Daha kısacası;

Alttaki satırı EKLE butonu ilk satırına ekleyiniz.

Application.EnableEvents = False

Alttaki satırı EKLE butonu son satırına ekleyiniz.

Application.EnableEvents = True

Hocam elinize sağlık çok teşekkür ediyorum hata giderildi sayenizde.

Yardım! "EKLE" komut butonuna bastığımda EXCEL kendini kapatıyor.

emreeken

Tabildot_Son23456.xls dosyasını indir - download

emreeken

Korhan Ayhan

Administrator

emreeken

emreeken

Korhan Ayhan

Administrator

emreeken

Korhan Ayhan

Administrator

emreeken