userform

sinemomec · 18 Temmuz 2022

userform üzerinden combobax ile verileri farklı excel sayfalarına kaydediyorum. yani kaydet yaptığım zaman gelenevrak son satırına, gelenkurum son satırına, gelenkonu son satırına kayıt yapıyor ancak combobaxta kaydettiğim verileri excel sayfasına gitmezsem göstermiyor ben her yeni kaydettiğimde combobaxta göstersin istiyorum.kod ekledin nasıl düzeltebilirim.

Kod:

Option Explicit
Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
    Range("C1").PasteSpecial xlPasteValues
    Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

AdemCan · 18 Temmuz 2022

Örnek Dosyanızı paylaşır mısınız?

sinemomec · 18 Temmuz 2022

İndir EVRAK KAYIT (Otomatik kaydedildi)

Dosyayı indir EVRAK KAYIT (Otomatik kaydedildi)

dosya.co

AdemCan · 18 Temmuz 2022

Gelen Evrak Kayıt Userformuna kodları ekleyiniz.

Kod:

Sub gelen_kurum_listesi()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Dizi = CreateObject("Scripting.Dictionary")
Son = Worksheets("GELENKURUM").Cells(Rows.Count, 1).End(3).Row
Liste = Worksheets("GELENKURUM").Range("A1:A" & Son)
   
With Cbgeldiğikurum
    .Clear
    For i = 1 To UBound(Liste)
        If Not Dizi.exists(Liste(i, 1)) Then
            Dizi.Add Liste(i, 1), Nothing
            .AddItem Liste(i, 1)
        End If
    Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

UserForm_Initialize ve Cmdkaydet_Click kodlarına da gelen_kurum_listesi satırını ekleyiniz.
Userform açılışında ve Kaydet işleminden sonra Gelenkurum sayfası A sütunundan kurum isimleri comboboxta sıralanır.

sinemomec · 18 Temmuz 2022

ben zaten a hücresine verileri gönderiyor ve c hücresinde mükerer kayıt yaptırıyorum ancak ben excel gelenkurum sayfasını açmaz isem kod çalışmıyor ben userformda kayıt yaptıgımda çalışmasını istiyorum

AdemCan · 18 Temmuz 2022

Yaptığım açıklamaya göre ekleyip kodu denediniz mi?

Ben, denemeden kod paylaşmıyorum ve kayıt işleminden sonra kurum isimleri comboboxa geliyor.

sinemomec · 18 Temmuz 2022

denedim ama hata aldım.

sinemomec · 18 Temmuz 2022

Kod:

Dim wsGELENEVRAK, wsGİDENEVRAK, wsPERSONELÖNTANIM, wsDESİMALDOSYA, wsKONU As Worksheet
Dim sonsatır, sil, deneme As Long
Private Sub Cbgeldiğikurum_Change()
If Cbgeldiğikurum = "" Then Exit Sub
deg = Mid(Cbgeldiğikurum.Value, Len(Cbgeldiğikurum.Value), 1)
If IsNumeric(deg) = True Then
MsgBox "SADECE HARF GİRİNİZ !", vbInformation, "BİLDİRİ"
Cbgeldiğikurum = Mid(Cbgeldiğikurum.Value, 1, Len(Cbgeldiğikurum.Value) - 1)
Cbgeldiğikurum.SetFocus
End If
Cbgeldiğikurum = Replace(Cbgeldiğikurum, "i", "İ")
Cbgeldiğikurum = Replace(Cbgeldiğikurum, "ı", "I")
Cbgeldiğikurum = StrConv(Cbgeldiğikurum, vbUpperCase)
End Sub
Private Sub Cbkonu_Change()
Cbkonu = Replace(Cbkonu, "i", "İ")
Cbkonu = Replace(Cbkonu, "ı", "I")
Cbkonu = StrConv(Cbkonu, vbUpperCase)
End Sub
Private Sub Cmdkaydet_Click()
If Cbgeldiğikurum.Text = "" Then
MsgBox "GELDİĞİ KURUM VE KURULUŞ BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbtarih.Text = "" Then
MsgBox "TARİH BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbevrakno.Text = "" Then
MsgBox "EVRAK NO BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf tbek.Text = "" Then
MsgBox "EK BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Cbdesimaldosya.Text = "" Then
MsgBox "DESİMAL DOSYA KODU OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Cbkonu.Text = "" Then
MsgBox "KONUSU OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Cbhavaleedilenmemur.Text = "" Then
MsgBox "HAVALE EDİLEN MEMUR BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("GELENEVRAK").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("GELENEVRAK").Cells(sonsatır, 1) = 1
Else
Worksheets("GELENEVRAK").Cells(sonsatır, 1) = Worksheets("GELENEVRAK").Cells(sonsatır - 1, 1) + 1
sonsatır2 = WorksheetFunction.CountA(Worksheets("GELENKURUM").Range("A:A")) + 1
sonsatrı3 = WorksheetFunction.CountA(Worksheets("KONUGELEN").Range("A:A")) + 1
End If
Worksheets("GELENEVRAK").Cells(sonsatır, 2) = Cbgeldiğikurum.Value
Worksheets("GELENEVRAK").Cells(sonsatır, 3) = Tbtarih.Value
Worksheets("GELENEVRAK").Cells(sonsatır, 4) = Tbevrakno.Value
Worksheets("GELENEVRAK").Cells(sonsatır, 5) = tbek.Value
Worksheets("GELENEVRAK").Cells(sonsatır, 6) = Cbdesimaldosya.Value
Worksheets("GELENEVRAK").Cells(sonsatır, 7) = Cbkonu.Value
Worksheets("GELENEVRAK").Cells(sonsatır, 8) = Cbhavaleedilenmemur.Value
Worksheets("GELENKURUM").Cells(sonsatır2, 1) = Cbgeldiğikurum.Value
Worksheets("KONUGELEN").Cells(sonsatır2, 1) = Cbgeldiğikurum.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Cbgeldiğikurum.Value = ""
Tbtarih.Value = ""
Tbevrakno.Value = ""
tbek.Value = ""
Cbdesimaldosya.Value = ""
Cbkonu.Value = ""
Cbhavaleedilenmemur.Value = ""
listele
gelen_kurum_listesi
End Sub


Private Sub CmdSil_Click()
sor = MsgBox("SEÇİLEN KAYIT SİLİNECEK.", vbYesNoCancel + vbInformation, "BİLDİRİ")
If sor = vbNo Then Exit Sub
If sor = vbCancel Then Exit Sub
For a = 0 To Lstgelenevrak.ListCount - 1
If Lstgelenevrak.Selected(a) Then
ara = Lstgelenevrak.List(a, 0)
Sheets("GELENEVRAK").Range("A:A").Find(what:=ara, lookat:=xlWhole).EntireRow.Delete
End If
Next
End Sub
Private Sub tbek_Change()
Dim sTxt As String
sTxt = tbek.Text
If sTxt = "" Then Exit Sub
If Right(sTxt, 1) Like "[0-9]" = False Then
tbek.Text = Left(sTxt, Len(sTxt) - 1)
End If
End Sub
Private Sub Tbtarih_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(Tbtarih.Value) Then
MsgBox "GEÇERLİ BİR TARİH GİRMEDİNİZ!", vbInformation, "BİLGİ"
Exit Sub
Else
Tbtarih.Value = Format(Tbtarih.Value, "dd.mm.yyyy")
End If
End Sub
Private Sub UserForm_Initialize()
listele
gelen_kurum_listesi
End Sub
Sub listele()
Dim X As Long
For X = 1 To 1000000
If Range("GELENEVRAK!A" & X).Value <> "" Then
X = X + 1
Else
Exit For
End If
Next
Lstgelenevrak.ColumnCount = 8
Lstgelenevrak.RowSource = "GELENEVRAK!$A2:H$" & X
Lstgelenevrak.ColumnWidths = "50;;60;150;25;;;100"
End Sub
Sub gelen_kurum_listesi()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Dizi = CreateObject("Scripting.Dictionary")
Son = Worksheets("GELENKURUM").Cells(Rows.Count, 1).End(3).Row
Liste = Worksheets("GELENKURUM").Range("A1:A" & Son)
  
With Cbgeldiğikurum
    .Clear
    For i = 1 To UBound(Liste)
        If Not Dizi.exists(Liste(i, 1)) Then
            Dizi.Add Liste(i, 1), Nothing
            .AddItem Liste(i, 1)
        End If
    Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

AdemCan · 18 Temmuz 2022

Kodlar hata vermeden işlemi tamamlıyor, aldığınız hata nedir?

AdemCan · 18 Temmuz 2022

Çalışma görüntüsü.

sinemomec · 19 Temmuz 2022

run-time error '2147467259(800040058);unspecified error bu hatayı veriyor

AdemCan · 19 Temmuz 2022

Belirttiğiniz hata ile karşılaşmadım.

Gelen evrak formundaki diğer comboboxlar içinde ekleme yaptım.

Evrak Kayıt Dosyası için tıklayınız.

sinemomec · 19 Temmuz 2022

evet aynen sizin gönderdiğinizde bir sorun yokken bende olanda hata veriyor anlayamadım sizin attığınız dosyadan devam edeceğim peki birşey soracağım ıkı dosya aynı olmasına rağmen boyutları farklı acaba neden

sinemomec · 19 Temmuz 2022

peki burayı alfabetik sıralama nasıl yaparım

AdemCan · 19 Temmuz 2022

Comboboxların içeriğini alfabetik sıralamak için Sayın @ÖmerBey 'in paylaşmış olduğu kodu kullandım.
Kaynak konu adresi https://www.excel.web.tr/threads/combobox-alfabetik-siralama.178414/post-979698
Bu şekilde forumda arama yaparak örnek konulara erişim sağlaya bilirsiniz.

Gelen kurum sıralaması, combobox butonuna tıkladığınız zaman çalışır.

Kod:

Private Sub Cbgeldiğikurum_DropButtonClick()
    With Cbgeldiğikurum
        For a = LBound(.List) To UBound(.List) - 1
            For b = a + 1 To UBound(.List)
                If .List(b) < .List(a) Then
                    X = .List(a)
                    .List(a) = .List(b)
                    .List(b) = X
                End If
            Next
        Next
    End With
End Sub

sinemomec · 19 Temmuz 2022

adem bey aynı hatayı gidenevrak da alıyorum acaba nasıl bir hata yapıyorum

AdemCan · 19 Temmuz 2022

Giden evrak forumda yaptığınız uygulama nedir?

Giden evrak formundaki comboboxlar için paylaştığım kodları uyarlamak istiyorsanız, rowsource özelliğinde yazan sayfa bilgilerini temizleyiniz.

Daha sonra gelen evrak formundan aldığınız kodlarda sayfa ismi ve combobox isimlerini değiştiriniz.

sinemomec · 19 Temmuz 2022

type mismatch hatası veriyor hiç anlayamadım nasıl bir hata yapıyorum

Kod:

Dim wsGELENEVRAK, wsGİDENEVRAK, wsPERSONELÖNTANIM, wsDESİMALDOSYA, wsKONUGELEN, wsKONUGİDEN, wsGİDENKURUM, wsGELENKURUM As Worksheet
Dim sonsatır, sil As Long
Private Sub Cbgönderilenkurum_Change()
If Cbgönderilenkurum = "" Then Exit Sub
deg = Mid(Cbgönderilenkurum.Value, Len(Cbgönderilenkurum.Value), 1)
If IsNumeric(deg) = True Then
MsgBox "SADECE HARF GİRİNİZ !", vbInformation, "BİLDİRİ"
Cbgönderilenkurum = Mid(Cbgönderilenkurum.Value, 1, Len(Cbgönderilenkurum.Value) - 1)
Cbgönderilenkurum.SetFocus
End If
Cbgönderilenkurum = Replace(Cbgönderilenkurum, "i", "İ")
Cbgönderilenkurum = Replace(Cbgönderilenkurum, "ı", "I")
Cbgönderilenkurum = StrConv(Cbgönderilenkurum, vbUpperCase)
End Sub
Private Sub Cbkonu_Change()
Cbkonu = Replace(Cbkonu, "i", "İ")
Cbkonu = Replace(Cbkonu, "ı", "I")
Cbkonu = StrConv(Cbkonu, vbUpperCase)
End Sub
Private Sub Cmdkaydet_Click()
If Cbgönderilenkurum.Text = "" Then
MsgBox "GÖNDERİLEN KURUM VE KURULUŞ BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Tbtarih.Text = "" Then
MsgBox "TARİH BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf tbek.Text = "" Then
MsgBox "EK BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Cbdesimaldosya.Text = "" Then
MsgBox "DESİMAL DOSYA OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Cbkonu.Text = "" Then
MsgBox "KONU DOSYA OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf Cbhavaleedenmemur.Text = "" Then
MsgBox "HAVALE EDEN MEMUR BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
End If
sonsatır = WorksheetFunction.CountA(Worksheets("GİDENEVRAK").Range("A:A")) + 1
sonsatır2 = WorksheetFunction.CountA(Worksheets("GİDENKURUM").Range("A:A")) + 1
sonsatrı3 = WorksheetFunction.CountA(Worksheets("KONUGİDEN").Range("A:A")) + 1
If sonsatır = 2 Then
Worksheets("GİDENEVRAK").Cells(sonsatır, 1) = 1
Else
Worksheets("GİDENEVRAK").Cells(sonsatır, 1) = Worksheets("GİDENEVRAK").Cells(sonsatır - 1, 1) + 1
End If
Worksheets("GİDENEVRAK").Cells(sonsatır, 2) = Cbgönderilenkurum.Value
Worksheets("GİDENEVRAK").Cells(sonsatır, 3) = Tbtarih.Value
Worksheets("GİDENEVRAK").Cells(sonsatır, 4) = tbek.Value
Worksheets("GİDENEVRAK").Cells(sonsatır, 5) = Cbdesimaldosya.Value
Worksheets("GİDENEVRAK").Cells(sonsatır, 6) = Cbkonu.Value
Worksheets("GİDENEVRAK").Cells(sonsatır, 7) = Cbhavaleedenmemur.Value
Worksheets("GİDENKURUM").Cells(sonsatır2, 1) = Cbgönderilenkurum.Value
Worksheets("KONUGİDEN").Cells(sonsatır2, 1) = Cbgönderilenkurum.Value
MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"
Cbgönderilenkurum.Value = ""
Tbtarih.Value = ""
tbek.Value = ""
Cbdesimaldosya.Value = ""
Cbkonu.Value = ""
Cbhavaleedenmemur.Value = ""
listele

giden_kurum_listesi
giden_konu_listesi



End Sub
Private Sub CmdSil_Click()
sor = MsgBox("SEÇİLEN VERİ SİLİNECEK.", vbYesNoCancel + vbInformation, "BİLDİRİ")
If sor = vbNo Then Exit Sub
If sor = vbCancel Then Exit Sub
For a = 0 To Lstgidenevrak.ListCount - 1
If Lstgidenevrak.Selected(a) Then
ara = Lstgidenevrak.List(a, 0)
Sheets("GİDENEVRAK").Range("A:A").Find(what:=ara, lookat:=xlWhole).EntireRow.Delete
End If
Next
End Sub
Private Sub tbek_Change()
Dim sTxt As String
sTxt = tbek.Text
If sTxt = "" Then Exit Sub
If Right(sTxt, 1) Like "[0-9]" = False Then
tbek.Text = Left(sTxt, Len(sTxt) - 1)
End If
End Sub
Private Sub Tbtarih_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(Tbtarih.Value) Then
MsgBox "GEÇERLİ BİR TARİH GİRMEDİNİZ!", vbInformation, "BİLGİ"
Exit Sub
Else
Tbtarih.Value = Format(Tbtarih.Value, "dd.mm.yyyy")
End If
End Sub
Private Sub UserForm_Initialize()
listele


giden_kurum_listesi
giden_konu_listesi

pson = Worksheets("PERSONELÖNTANIM").Cells(Rows.Count, 2).End(3).Row
pliste = Worksheets("PERSONELÖNTANIM").Range("B2:B" & pson)
With Cbhavaleedilenmemur
    .Clear
    .List = pliste
End With

dson = Worksheets("DESİMALDOSYA").Cells(Rows.Count, 2).End(3).Row
dliste = Worksheets("DESİMALDOSYA").Range("D2:D" & dson)
With Cbdesimaldosya
    .Clear
    .List = dliste
End With


End Sub
Sub listele()
Dim X As Long
For X = 1 To 1000000
If Range("GİDENEVRAK!A" & X).Value <> "" Then
X = X + 1
Else
Exit For
End If
Next
Lstgidenevrak.ColumnCount = 7
Lstgidenevrak.RowSource = "GİDENEVRAK!$A2:H$" & X
Lstgidenevrak.ColumnWidths = "50;300;60;25;200;300;100"
End Sub

Sub giden_kurum_listesi()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Dizi = CreateObject("Scripting.Dictionary")
Son = Worksheets("GİDENKURUM").Cells(Rows.Count, 1).End(3).Row
Liste = Worksheets("GİDENKURUM").Range("A1:A" & Son)

With Cbgönderilenkurum
    .Clear
    For i = 1 To UBound(Liste)
        If Not Dizi.exists(Liste(i, 1)) Then
            Dizi.Add Liste(i, 1), Nothing
            .AddItem Liste(i, 1)
        End If
    Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Sub giden_konu_listesi()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Dizi = CreateObject("Scripting.Dictionary")
Son = Worksheets("KONUGİDEN").Cells(Rows.Count, 1).End(3).Row
Liste = Worksheets("KONUGİDEN").Range("A1:A" & Son)

With Cbkonu
    .Clear
    For i = 1 To UBound(Liste)
        If Not Dizi.exists(Liste(i, 1)) Then
            Dizi.Add Liste(i, 1), Nothing
            .AddItem Liste(i, 1)
        End If
    Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub Cbgönderilenkurum_DropButtonClick()
    With Cbgönderilenkurum
        For a = LBound(.List) To UBound(.List) - 1
            For b = a + 1 To UBound(.List)
                If .List(b) < .List(a) Then
                    X = .List(a)
                    .List(a) = .List(b)
                    .List(b) = X
                End If
            Next
        Next
    End With
End Sub
Private Sub Cbkonu_DropButtonClick()
    With Cbkonu
        For a = LBound(.List) To UBound(.List) - 1
            For b = a + 1 To UBound(.List)
                If .List(b) < .List(a) Then
                    X = .List(a)
                    .List(a) = .List(b)
                    .List(b) = X
                End If
            Next
        Next
    End With
End Sub

sinemomec · 19 Temmuz 2022

kadir bey gelenevrak sayfasında belirli bir kayıt yaptıktan sonra gönderilen kurum ve konuları girdiğim verileri karıştırma yapıyor

AdemCan · 19 Temmuz 2022

Giden evrak formunda, UserForm_Initialize bölümündeki Cbhavaleedilenmemur başlığını Cbhavaleedenmemur olarak değiştiriniz.

Kayıtları karıştırma durumunu inceleme için dosyanızı yeniden paylaşır mısınız?
Yarın müsait bir zamanda incelemeye çalışırım.

userform

sinemomec

AdemCan

Altın Üye

sinemomec

İndir EVRAK KAYIT (Otomatik kaydedildi)

AdemCan

Altın Üye

sinemomec

AdemCan

Altın Üye

sinemomec

sinemomec

AdemCan

Altın Üye

AdemCan

Altın Üye

sinemomec

AdemCan

Altın Üye

Ekli dosyalar

sinemomec

sinemomec

AdemCan

Altın Üye

sinemomec

AdemCan

Altın Üye

sinemomec

sinemomec

AdemCan

Altın Üye