Export danych z Excela do pliku PLI MultiCash   strona główna:
A po co ten Excel ;-)
 
    Chciałbym dziś pokazać sposób na exportowanie danych z excela do pliku pli programu MulitCash. Program ten to dość często używany  
program do wysyłania przelewów. Jedną z jego (nieraz najważniejszych) funkcji jest możliwość importu pliki PLI z poleceniami przelewu.    
Z tego powodu wiele systemów księgowych, płacowych ... ma możliwość generowania takiego pliku. I czy to płacimy faktury zakupu, czy   Plik z przykładem
płacimy wynagrodzenia (dla 100 i więcej) pracowników, zamiast przeklepywać z wydrukowanej listy do MultiCash'a exportujemy z naszego   xls2pli.zip
programu dane do pliku PLI i importujemy go do MultiCash.    
    Ktoś powie "..niepotrzebna zabawa! Mój system Księgowy/Płacowy też ma taką funkcję.." i racja.. Jednak niektóre systemy nie mają   
lub są z jakiegoś powodu nieprzydatne. A poza tym: w ramach odpowiedzi na pytanie: czy z Excela też można taki plik exportować?  
Powstał zalążek narzędzia (na razie w wersji 01) które to umożliwia.  
 
    Będzie to zwykły pliczek xls. Dwa Arkusze: Przelewy i Kontrahenci.  
 
 
 
 
 
 
 
 
 
 
 
Tu tworzymy bazę kontrahentów  
 - LP  
 - index Jest to skrót po którym będziemy szukać kontrahenta w bazie. Powinien być unikatowy w skali kolB na razie nic tego nie pilnuje  
 - nazwa, ulica, miasto Dane kontrahenta (max 35 znaków) Warunek w sprawdzaniu poprawności.  
 - nr rach. 26 znakowy nr rachunku. W tej wersji tylko przelewy do Polski.  
 - CheckNBR Funkcja UDF sprawdzająca poprawność nr rach.  
 
Public Function CheckNRB(strNrKonta As String, _   Wyjaśnienie kodu i 
                         Optional strKraj As String = "PL") As Boolean   wersja formułami arkuszowymi..
    Dim arr As Variant, j As Integer   www.excelforum.pl
    Dim strNR As String, i As Integer, s As Long  
      
    arr = VBA.Array(1, 10, 3, 30, 9, 90, 27, 76, 81, _  
                   34, 49, 5, 50, 15, 53, 45, 62, 38, _  
                   89, 17, 73, 51, 25, 56, 75, 71, 31, 19, 93, 57)  
      
    strNR = VBA.Replace(strNrKonta, " ", "") & _  
            Asc(Left(strKraj, 1)) - 55 & _  
            Asc(Right(strKraj, 1)) - 55  
      
    If Len(strNR) <> 30 Then Exit Function  
    strNR = Right(strNR, Len(strNR) - 2) & Left(strNR, 2)  
 
    For i = UBound(arr) + 1 To 1 Step -1  
        s = s + CByte(Mid(strNR, i, 1)) * arr(j)  
        j = j + 1  
    Next  
 
    CheckNRB = s Mod 97 = 1  
End Function  
 
Dla tego Arkusza zdefiniowałem też dwie nazwy:  
 - kolB    =PRZESUNIĘCIE(Kontrahenci!$B$1;1;;Last(Kontrahenci!$B:$B)-1)   Funkcja Last
 - kolF    =PRZESUNIĘCIE(kolB;;4)  
 
I Arkusz Przelewy  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 - Dane naszej firmy powyżej listy przelewów.   
 - W kom.G7 CheckNBR.   
 - Tytuł Płatności (kolumny F-I) ilość znaków max 35  
 
Zmieniając zaznaczenie na kol.B poniżej 10 wiersza...  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
    If Target.Cells.Count > 1 Then Exit Sub  
    If Target.Row < 11 Then Exit Sub  
    If Target.Column = 2 Then ufKontrahent.Show  
End Sub
 
 
Chciałem tym formularzem ułatwić podanie odpowiedniego  
indeksu dla kontrahenta któremu chcemy coś zapłacić.  
   Wpisywanie do TextBox'a w lewym-górnym rogu będzie   
powodowało zaznaczanie na ListBox'ie podobnych (Like)  
Indeksów. Można szukać po Indeksie lub nazwie -   
ToggleButton z Caption Index..  
   Kiedy na ListBoxie pozostanie już tylko jedna zaznaczona  
firma przyciśnięcie klawisza enter będzie wpisywało właściwy  
indeks do Ark.Przelewy.  
 
 
Option Explicit  
Private bNotEnableEvents As Boolean  
 
Private Sub UserForm_Initialize()  
    Dim xlWks As Excel.Worksheet, ostAG As Long  
    Dim tbl As Variant  
      
    Set xlWks = ThisWorkbook.Worksheets("Kontrahenci")  
    With xlWks    
        ostAG = last(.Columns("A:G"))   Sortowanie na podstawie
        tbl = .Range("B2:E" & ostAG)   Funkcja SortowanieBabelkowe2D
        SortowanieBabelkowe2D tbl, 1  
        Me.ListBox1.List = tbl    
        Me.ToggleButton1.Caption = "Index"  
        Me.TextBox1.SetFocus  
    End With  
    Set xlWks = Nothing  
End Sub  
 
Private Sub TextBox1_Change()  
    If Len(Me.TextBox1) = 0 Then Exit Sub  
      
    Dim tbl As Variant, i As Long, j As Integer  
      
    Select Case Me.ToggleButton1.Caption  
        Case "Nazwa": j = 1  
        Case "Index": j = 0  
    End Select  
      
    With Me.ListBox1  
        For i = .ListCount - 1 To 0 Step -1  
            If UCase(.List(i, j)) Like "*" & UCase(Me.TextBox1) & "*" Then  
                .Selected(i) = True  
                .ListIndex = i  
            Else  
                .Selected(i) = False  
            End If  
        Next  
    End With  
End Sub  
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)  
    Dim strIndex As String  
 
    Select Case KeyCode  
        Case 13  
            If Len(Me.TextBox1) > 0 Then  
                Dim ile As Long, i As Long  
                With Me.ListBox1  
                    For i = 0 To .ListCount - 1  
                        If .Selected(i) Then  
                            ile = ile + 1  
                            strIndex = .List(i, 0)  
                        End If  
                    Next  
                End With  
                Select Case ile  
                    Case 0  
                        MsgBox "Brak firmy spełniająącej warunki filtracji" & vbNewLine & _  
                                     "Popraw!!", vbExclamation  
                        bNotEnableEvents = True  
                        With Me.TextBox1  
                            .SelStart = 0  
                            .SelLength = Len(.Value)  
                            .SetFocus  
                        End With  
                    Case 1  
                        ActiveCell = strIndex  
                        Unload Me  
                    Case Else  
                        MsgBox "Jest więcej niż jedna firma spełniająca warunki filtracji" & vbNewLine & _  
                               "Doprecyzuj", vbInformation  
                        bNotEnableEvents = True  
                        With Me.TextBox1  
                            .SelLength = Len(.Value)  
                            .SetFocus  
                        End With  
                          
                End Select  
            End If  
          
        Case 27: Unload Me  
          
    End Select  
End Sub  
 
Private Sub ToggleButton1_Click()  
    With Me.ToggleButton1  
        .Caption = IIf(.Value, "Nazwa", "Index")  
    End With  
    Me.TextBox1.SetFocus  
End Sub  
 
Private Sub ToggleButton1_Enter()  
    If bNotEnableEvents Then  
        Me.TextBox1.SetFocus  
        bNotEnableEvents = False  
    End If  
End Sub  
 
Nie ma chyba co dużo tłumaczyć.. W TextBox1_KeyDown jest oprogramowany Enter i Ecs. Chciałem żeby prawie ciągle był aktywny  
TextBox do filtrowania listy kontrahentów.   
 
Zostało nam jedynie zapis danych od pliku PLI, plik ten to tak naprawdę zwykły plik tekstowy o rozszerzeniu .pli jednak dane w nim  
zapisane muszą być w odpowiednim układzie, a sam plik zapisany w odpowiednim kodowaniu.  
 
Najpierw stworzymy sobie tablicę z danymi  
 
Option Explicit  
 
Private Type vDaneInfo  
    lngData As Long  
    strNrRach As String  
    lngNrBanku As Long  
    strNazwa As String  
End Type  
 
Private Type vDaneKontr  
    strNazwa As String  
    strNrRach As String  
    lbgNRBank As Long  
End Type  
 
 
Sub Start()  
    Dim xlWks As Excel.Worksheet, ostAG As Long  
    Dim tblDane As Variant  
    Dim vDaneNadawca As vDaneInfo, vDane() As Variant, i As Long  
      
    Set xlWks = ThisWorkbook.Worksheets("Przelewy")  
    With xlWks  
        ostAG = last(.Columns("A:G"))  
        tblDane = .Range("B11:I" & ostAG)  
        vDaneNadawca.lngData = CLng(Replace(Format(.[B3], "yyyy-mm-dd"), "-", ""))  
        vDaneNadawca.strNrRach = Chr(34) & Replace(.[C7], " ", "") & Chr(34)  
        vDaneNadawca.lngNrBanku = Mid(.[C7], 3, 10) * 1  
        vDaneNadawca.strNazwa = Chr(34) & .[C2] & Chr(124) & _  
                                        .[C3] & Chr(124) & _  
                                        .[C4] & Chr(124) & _  
                                        .[C5] & Chr(34)  
    End With  
    Set xlWks = Nothing  
 
    ReDim vDane(1 To UBound(tblDane), 1 To 15)  
    For i = 1 To UBound(tblDane)  
        vDane(i, 1) = 110  
        vDane(i, 2) = vDaneNadawca.lngData  
        vDane(i, 3) = tblDane(i, 3) * 100  
        vDane(i, 4) = vDaneNadawca.lngNrBanku  
        vDane(i, 5) = 0  
        vDane(i, 6) = vDaneNadawca.strNrRach  
        vDane(i, 8) = vDaneNadawca.strNazwa  
        With DaneKontrahenta(CStr(tblDane(i, 1)))  
            vDane(i, 7) = Replace(.strNrRach, " ", "")  
            vDane(i, 9) = .strNazwa  
            vDane(i, 11) = .lbgNRBank  
        End With  
        vDane(i, 10) = 0  
        vDane(i, 12) = Chr(34) & tblDane(i, 5) & Chr(124) & _  
                                 tblDane(i, 6) & Chr(124) & _  
                                 tblDane(i, 7) & Chr(124) & _  
                                 tblDane(i, 8) & Chr(34)  
        vDane(i, 13) = String(2, Chr(34))  
        vDane(i, 14) = String(2, Chr(34))  
        vDane(i, 15) = Chr(34) & "51" & Chr(34)  
    Next  
      
    TBL2TXT_ADO vDane, ThisWorkbook.Path & "\" & _  
                       Format(Now(), "yyyymmddhhmm") & ".PLI", _  
                       "iso-8859-2"  
      
    MsgBox "Plik utworzony"  
End Sub  
 
Function DaneKontrahenta(strIndex As String) As vDaneKontr  
    Dim xlKontr As Excel.Worksheet, ostAG As Long  
    Dim tbl As Variant, i As Long  
      
    Set xlKontr = ThisWorkbook.Worksheets("Kontrahenci")  
    ostAG = last(xlKontr.Columns("A:G"))  
    tbl = xlKontr.Range("B2:F" & ostAG)  
    For i = 1 To UBound(tbl)  
        If tbl(i, 1) = strIndex Then  
            DaneKontrahenta.strNazwa = _  
                Chr(34) & tbl(i, 2) & Chr(124) & Chr(124) & _  
                          tbl(i, 3) & Chr(124) & _  
                          tbl(i, 4) & Chr(34)  
            DaneKontrahenta.strNrRach = Chr(34) & tbl(i, 5) & Chr(34)  
            DaneKontrahenta.lbgNRBank = Mid(tbl(i, 5), 3, 10) * 1  
            Exit For  
        End If  
    Next  
End Function  
 
Częściami....  
 
Dim vDaneNadawca As vDaneInfo  
 
Wszystkie dane dotyczące nadawcy chciałem złapać do jednego typu..  
 
Private Type vDaneInfo  
    lngData As Long  
    strNrRach As String  
    lngNrBanku As Long  
    strNazwa As String  
End Type  
 
Dane te pochodzą z Ark.Przelewy ponad listą przelewów..  
 
    Set xlWks = ThisWorkbook.Worksheets("Przelewy")  
    With xlWks  
        ostAG = last(.Columns("A:G"))  
        tblDane = .Range("B11:I" & ostAG)  
        vDaneNadawca.lngData = CLng(Replace(Format(.[B3], "yyyy-mm-dd"), "-", ""))  
        vDaneNadawca.strNrRach = Chr(34) & Replace(.[C7], " ", "") & Chr(34)  
        vDaneNadawca.lngNrBanku = Mid(.[C7], 3, 10) * 1  
        vDaneNadawca.strNazwa = Chr(34) & .[C2] & Chr(124) & _  
                                        .[C3] & Chr(124) & _  
                                        .[C4] & Chr(124) & _  
                                        .[C5] & Chr(34)  
    End With  
    Set xlWks = Nothing  
 
a więc lngData: 20111128  
strNrRach: "120123456..." (bez spacji w cudzysłowie)  
lngNrBanku - liczba. Część nr rachynku identyfuikujący bank.  
strNazwa "Nazwa|Nazwa2|ulica|Miasto" (jasne :-) )  
 
    ReDim vDane(1 To UBound(tblDane), 1 To 15)  
    For i = 1 To UBound(tblDane)  
        vDane(i, 1) = 110  
        vDane(i, 2) = vDaneNadawca.lngData  
        vDane(i, 3) = tblDane(i, 3) * 100  
        vDane(i, 4) = vDaneNadawca.lngNrBanku  
        vDane(i, 5) = 0  
        vDane(i, 6) = vDaneNadawca.strNrRach  
        vDane(i, 8) = vDaneNadawca.strNazwa  
        With DaneKontrahenta(CStr(tblDane(i, 1)))  
            vDane(i, 7) = Replace(.strNrRach, " ", "")  
            vDane(i, 9) = .strNazwa  
            vDane(i, 11) = .lbgNRBank  
        End With  
        vDane(i, 10) = 0  
        vDane(i, 12) = Chr(34) & tblDane(i, 5) & Chr(124) & _  
                                 tblDane(i, 6) & Chr(124) & _  
                                 tblDane(i, 7) & Chr(124) & _  
                                 tblDane(i, 8) & Chr(34)  
        vDane(i, 13) = String(2, Chr(34))  
        vDane(i, 14) = String(2, Chr(34))  
        vDane(i, 15) = Chr(34) & "51" & Chr(34)  
    Next  
 
do tablicy vDane którą będę zapisywałe do pliki PLI zapisuję całą strukturę pliku PLI. Z ciekawych:  
 - vDane(i, 3) wartość przelewu *100. Wymagany Format 100,00zł to 10000 itd...  
 - vDane(i, 7) ,9 , 11 to dane pochodzące z Ark.Kontrahenci. Mam index więc po nim trzeba poszukać. Jednak zamiast  
szukać 2 razy: 1. Dane: Nazwa, Adres 2. NrRach i NrBanku. Stworzyłem typ vDaneKontr i funkcje która go zwraca  
 
Private Type vDaneKontr  
    strNazwa As String  
    strNrRach As String  
    lbgNRBank As Long  
End Type  
 
Function DaneKontrahenta(strIndex As String) As vDaneKontr (...)  
 
Zapis do pliku PLI...  
  Zapis tablicy do pliku txt o wskazanym kodowaniu
    TBL2TXT_ADO vDane, ThisWorkbook.Path & "\" & _  
                       Format(Now(), "yyyymmddhhmm") & ".PLI", _  
                       "iso-8859-2"  
 
Procedura TBL2TXT_ADO jest na tej stronie w dziale ADO w części poświęconej TXT (link z prawej)  
   W efekcie mamy plik PLI, a więc w MulitCash'u / Moduł PLI / Zakładka: Zlecenia / Importuj polecenia ... :-)  
Enjoi :-)