E-Fatura Kurum List...
 
Bildirimler
Hepsini Temizle

E-Fatura Kurum Listesi  

  RSS
 Anonim

E Fatura'ya kayıtlı Kurumların listesini ListBox'ta görüntüleyip arama yapabilirsiniz. 

Faydalı olması dileğiyle... --)(

[img] [/img]

■ Module kodları;
Public Dosya_Yolu As String, Desk As String, Rky As Object

Sub Baglan
()
    Set Rky = CreateObject("adodb.connection")
    Rky.Open "provider=microsoft.ace.oledb.12.0; data source=" & _
    Dosya_Yolu 
& ";extended properties=""Excel 12.0;hdr=yes"""
End Sub

Sub Emre
()
    UserForm1.Show
End Sub

 UserForm kodları;
Private Declare Function Dosya_Indir Lib "urlmon" Alias "URLDownloadToFileA" _
    
(ByVal pCaller As Long, ByVal Adres As String, ByVal Dosya_Adı As String, _
    ByVal dwReserved As Long
, ByVal lpfnCB As Long) As Long

Private Sub CommandButton1_Click
()
    Dim rs As Object, Sorgu As String, Dosya_Adresi As String, Ac As Workbook
    Set rs 
= CreateObject("adodb.recordSet")
    Sorgu = "Select [Kurum Unvanı] from [EFatura - Kurumlar$]"
    rs.Open Sorgu, Rky, 1, 1
    ListBox1
.Column = rs.getrows
    Label2
.Caption = ListBox1.ListCount & " Adet Kurum Listelendi."
    rs.Close
    Set rs 
= Nothing: Sorgu = ""
End Sub

Private Sub UserForm_Activate
()
    Application.ScreenUpdating = False
    Desk 
= CreateObject("Wscript.Shell").specialfolders("Desktop")
    If Dir(Desk & "\efatura_kurumlar.xls") <> "" Then Kill Desk & "\efatura_kurumlar.xls"
    Dosya_Yolu = Desk & "\efatura_kurumlar.xls"
    Dosya_Adresi = "http://sorgu.efatura.gov.tr/kullanicilar/oliste.php?bolum=asltd&xls"
    Dosya_Indir 0&, Dosya_Adresi, Dosya_Yolu, 0&, 0&
    Application.DisplayAlerts = False
    Set Ac 
= Workbooks.Open(Dosya_Yolu)
    ActiveWorkbook.SaveAs Filename:=Dosya_Yolu, FileFormat:=xlExcel8, _
    Password
:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Ac
.Close False
    Application
.ScreenUpdating = True
    Application
.DisplayAlerts = True
    Call Baglan
End Sub

Private Sub Textbox1_Change
()
    Dim Evn As Object, s As String
    Call Baglan
    Set Evn 
= CreateObject("adodb.recordset")
    Evn.Open "Select [Kurum Unvanı] from [EFatura - Kurumlar$] where [Kurum Unvanı] LIKE '%" & TextBox1.Text & "%'", Rky, 1, 1
    ListBox1
.Clear
    If Evn
.RecordCount > 0 Then
        ListBox1
.Column = Evn.getrows
    End If
    Evn
.Close
End Sub

Private Sub UserForm_Terminate
()
    Rky.Close
    Set Rky 
= Nothing
End Sub

■ Gerekli nesneler:
1 Adet UserForm
1 Adet ListBox
1 Adet TextBox
1 Adet CommandButton

 [url= http://www.excelvba.net/download/file.php?id=20658] Dosyayı buradan da indirebilirsiniz[/url]

-------------------------------------------------------------------------------------------------------------------------------------------------------

■ Ayrıca XML dosyasından veri alma ile ilgili şu alternatif çalışma da kullanılabilir;

[img] [/img]

 UserForm kodları;

Private Type Veriler
    Vergino As String
    Adi     As String
End Type

Private Sub CommandButton1_Click()
Dim Firma As Veriler
Dim xml As Object
Dim liste As Boolean, elemanlar As Object
Set xml = CreateObject("MSXML2.DOMDocument")
Label1.Caption = ""
DoEvents
xml.async = False
ListView1.ListItems.Clear
CommandButton1.Caption = "Bekleyiniz..."
liste = xml.Load("https://connect.diyalogo.com/download/userList.xml")
If liste Then
    For Each elemanlar In xml.documentElement.childNodes
        say = say + 1
        DoEvents
        Firma.Vergino = elemanlar.childNodes.Item(0).Text
        Firma.Adi = elemanlar.childNodes.Item(2).Text
            With ListView1
                .ListItems.Add , , Firma.Vergino
                .ListItems(.ListItems.Count).ListSubItems.Add , , Firma.Adi
                .ListItems(.ListItems.Count).EnsureVisible
            End With
        Label1.Caption = say & " firma listelendi."
    Next elemanlar
End If
CommandButton1.Caption = "Listeyi Güncelle"
say = 0
Set xml = Nothing
Set elemanlar = Nothing
MsgBox "Listeleme işlemi tamamlandı.  ", vbInformation, "Www.ExcelVBA.Net"
End Sub

Private Sub CommandButton2_Click()
Range("a1").Value = "Vergi Numarası"
Range("b1").Value = "Firma Adı"
With ListView1
    For i = 1 To .ListItems.Count
        Range("a65536").End(3)(2, 1).Value = .ListItems(i).Text
        Range("a65536").End(3)(1, 2).Value = .ListItems(i).ListSubItems(1).Text
    Next i
End With
Columns.AutoFit
Unload Me
End Sub

Private Sub UserForm_Initialize()
With ListView1
    .FullRowSelect = True
    .Gridlines = True
    .View = lvwReport
    .ColumnHeaders.Add , , "Vergi No"
    .ColumnHeaders.Add , , "Firma Adı", .ColumnHeaders(1).Width * 5
End With
End Sub

■ Gerekli nesneler:
1 Adet UserForm
1 Adet ListView
1 Adet Label
2 Adet CommandButton

[b]Hoşça kalın ![/b]  --)(

Alıntı
Gönderildi : 11/12/2013 19:06
oldmember
(@yavuzfilizlibay)
Üye

Eline sağlık güzel olmuş

CevapAlıntı
Gönderildi : 11/12/2013 19:23
 Anonim

Teşekkürler Yavuz Bey, beğenmenize sevindim. [evet] 

İyi akşamlar.

CevapAlıntı
Gönderildi : 11/12/2013 19:44
emre özaydın
(@emreozaydin)
Üye

emeğinize sağlık

 

CevapAlıntı
Gönderildi : 14/01/2014 02:14
 Anonim

[quote user="emre özaydın"]

emeğinize sağlık

 

[/quote]

Teşekkürler [b]Emre Bey[/b]. --)( 

CevapAlıntı
Gönderildi : 15/01/2014 14:50
Halil Tekin
(@HalilTekin)
Üye

ikiside çalışmıyor destek olurmusunuz

CevapAlıntı
Gönderildi : 21/10/2016 15:00
Rıza ŞAHAN
(@www-rizasahan-com)
Değerli Üye Forum Yöneticisi

Tam Muhasebe ve Mali İşler departmanına göre. Şu an firmaların çoğu hala kimin E-fatura kullanıp kullanmadığını bilmiyor.

CevapAlıntı
Gönderildi : 23/10/2016 16:55
irfan-deveci
(@irfan-deveci)
Üye

[quote user="Halil Tekin"]

ikiside çalışmıyor destek olurmusunuz

[/quote]

evet nedense çalışmadi ekran geliyor ama sorgu yazdığımda hata veriyor acaba bi ayrı bir eklentimi atmamız gerekiyor

CevapAlıntı
Gönderildi : 24/10/2016 17:11
Ozcan Dogan
(@OzcanDogan)
Üye

Bu dosyanın çalışan hali var mı?

CevapAlıntı
Gönderildi : 15/01/2017 16:57
Paylaş: