Dodatek XLAM jako baza danych

Od jakiegoś czasu szukałem rozwiązania, aby ustawić skoroszyt Excel jako bazę danych dla innych skoroszytów. Ostatnio wykonałem test z plikiem XLAM na dysku sieciowym, który potwierdza że takie rozwiązanie jest możliwe, ale dopiero jak ruszy pierwsza aplikacja wtedy będę miał 100% pewność.

Aby dowiedzieć się jak stworzyć plik .xlam zajrzyj do posta „Tworzenie dodatku w Excelu”.

Poniższy prosty kod potwierdza, że dodatek XLAM może być używany jako „baza danych”. Po dodaniu dodatku do Excela, makro może być uruchomione w każdym skoroszycie. Excel rozróżnia dwa różne pliki jako ThisWorkbook i ActiveWorkbook. Jeden to otwarty skoroszty .xlsx, a drugi dodatek .xlam.

Poniższy pokazuje w całości, choć tylko fragment to używanie .xlam jako bazy danych.

' Source: n/d

Public Sub XLAMDB()
Dim i As Long

With ThisWorkbook.Sheets("Ceny")
    i = 1
    Do Until .Cells(i, 1) = ""
        ActiveWorkbook.ActiveSheet.Cells(i, 1) = .Cells(i, 1)
        ActiveWorkbook.ActiveSheet.Cells(i, 2) = .Cells(i, 2)
        ActiveWorkbook.ActiveSheet.Cells(i, 3) = .Cells(i, 3)
    i = i + 1
    Loop
End With
End Sub

Poniżej przedstawiam kod, który wykorzystuje dodatek XLAM jako bazę danych. Ok, zapewne ktoś zapyta „po co?”. Już tłumaczę. Stworzyłem aplikację, która sprawdza niektóre z lokalizacji magazynowych – nie będę wchodzić w szczegóły. Ważne jest to, że użytkownik ma za zadanie obrobić dane z SAP, które zostały zrzucone. Normalnie, aby obrobić dane powinien zaimportowane dane skopiować do pliku .xlsm, gdzie ukryty jest kod i w jakimś arkuszu są podane lokalizacje magazynowe, które mają być brane pod uwagę. Czyli de facto dane z arkusza w pliku .xlsm to tak na prawdę baza danych. Dzięki .xlam, nie ma konieczności szukania pliku .xlsm by uruchomoć kod – jest on dostępny od ręki z bazą lokalizacji, które mają być sprawdzone.

Option Explicit

' ----------- INFO O MODULE v. 0.0.21 ------------------------------------------------------
' 1. Automatycznie tworzenie zlecenia przeniesienia towaru w lokalizacje Replenishmentu.
'    Automatyczna obróbka danych uzyskanych w SAP, ostateteczny dokument przekazywany jest
'    magazynierowi - jako zlecenie przeniesienia towaru.
' 2. Kod z tego modułu ukryty jest w dodatku XLAM - który trzeba "zainstalować lokalnie"
'    na komputerze osoby wykonującej kod.
' 3. Dodatek XLAM wykorzystywany jest jako baza danych (arkusz Replenishment Bin), gdzie
'    przechowywane są wszytskie lokalizacje Replenishmentu na magazynie.
' ------------------------------------------------------------------------------------------

Public Sub FinalizeReplenishment()
' Tworzenie druku Replenishmentu (pola zbiorcze) do wydania pracownikowi
' magazynu, aby przemagazynowac towaru do lokalizacji Replenishmentu

Dim XlamFileName, ReplenishmentFile, CodeVersion As String
Dim ThisWorkbookCounter, XlamWorkbookCounter, LastRow, i  As Long
Dim rng As Range
Dim ErrorJump, StartTime, EndTime, FinalTime

On Error GoTo ErrorJump

' Przypisanie zmiennych
StartTime = Format(Time(), "Long Time")
CodeVersion = "App. v.0.0.21" 'do ewentualnej zmiany
XlamFileName = ThisWorkbook.Name
ReplenishmentFile = ActiveWorkbook.Name
ThisWorkbookCounter = 2
XlamWorkbookCounter = 2

With Workbooks(ReplenishmentFile).ActiveSheet

    ' Znalezienie ostatnego wiersza w aktywnym arkuszu
    LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row

    ' Dodawanie formuły Wyszukaj.Pionowo aby wyróżnić lokalizacje
    ' Replenishmentu zgodne z tymi w bazie danych
    .Cells(1, 20) = "Formula"
    .Cells(2, 20).Formula = "=VLOOKUP(J2,'[" & XlamFileName & "]Replenishment Bin'!$A$2:$E$71,1,0)"
    .Range("T2").AutoFill Destination:=Range("T2:T" & LastRow)
    
    ' Filtrowanie danych - pokazanie tylko Replenishmentu z całości
    ' zrzutut z SAP, gdzie są wszysytkie Transfer Order Numbers
    .Range("A1:T1").Select
    Selection.AutoFilter
    .Range("T1").Activate
    .Range("$A$1:$T" & LastRow).AutoFilter Field:=20, Criteria1:="<>#N/A", Operator:=xlFilterValues
    
    ' Kopiowanie pofiltrowanych danych w inne
    ' miejsce w akruszu aby je zachować
    .Range("$A$1:$T" & LastRow).Select
    Selection.Copy
    .Cells(1, 22).Select
    .Paste
    
    ' Usuwanie danych źródłowych - robienie miejsca dla finalnych danych
    .Columns("A:U").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
    ' Usuwanie niepotrzebnych kolumn z finalnego pliku
    .Cells(1, 2) = "Barcode TO"
    .Columns("G:I").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    .Columns("H:Q").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
    ' Znalezienie ostatnego wiersza w finalnych danych
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    
    ' Tworzenie kodów kreskowych z TO
    ' Ustawianie rodzaju czcionki i rozmiaru czcionki
    .Cells.Select
    With Selection
        .Font.Name = "Calibri"
        .Font.Size = 11
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
    End With
    For i = 2 To LastRow
        .Cells(i, 2) = "*" & .Cells(i, 1) & "*"
        .Cells(i, 2).Font.Name = "Free 3 of 9 Extended"
        .Cells(i, 2).Font.Size = 26
    Next i
    
    ' Dodanie informacji pod zleceniem Replenishmentu
    .Cells(LastRow + 2, 1) = "                            " ' trochę uproszczone poszerzanie kolumny / lepsze dopsowanie do wydruku
    .Cells(LastRow + 2, 2) = "Uzupelnienie lokalizacji pickingowych"
    .Cells(LastRow + 2, 2).HorizontalAlignment = xlLeft
    .Cells(LastRow + 2, 3) = "                                  " ' trochę uproszczone poszerzanie kolumny / lepsze dopsowanie do wydruku
    .Cells(LastRow + 4, 2) = "Zrealizowal - ........................... / data - ..................."
    .Cells(LastRow + 4, 2).HorizontalAlignment = xlLeft
    
    ' Dodawanie obramowania
    Set rng = Range("A1:G" & LastRow)
    With rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
    ' Dopasowanie szerokości kolumn dla calego arkusza
    .Cells.Select
    Columns.EntireColumn.AutoFit
    Rows.EntireRow.AutoFit
    
    ' Dopsowanie zawartości do wydruku
    .PageSetup.PrintArea = "$A:$G"
    Application.PrintCommunication = False
    With .PageSetup
        .PrintTitleRows = "$1:$1"
        .Orientation = xlLandscape
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .CenterHorizontally = True
    End With
    Application.PrintCommunication = True
    
    ' Potwierdzenie wykonania kodu
    .Cells(1, 1).Select
    EndTime = Format(Time(), "Long Time")
    FinalTime = Format(CDate(EndTime) - CDate(StartTime), "Long Time")
    MsgBox "Wykonano w czasie " & FinalTime & ".", vbInformation, CodeVersion & " POTWIERDZENIE..."
    Exit Sub '
    
End With

Exit Sub
    
' Obsługa ewentualnych błedów
ErrorJump:

MsgBox "Kod zostal zatrzymany. Popraw bledy i uruchom makro jeszcze raz." & Chr(10) & Chr(10) & _
        "Kod bledu: " & Err.Number & Chr(10) & _
        "Opis bledu: " & Err.Description & Chr(10) & _
        "Linia kodu: " & Erl, vbCritical, CodeVersion & " BLAD KODU..."
End Sub

Dodaj komentarz

Twój adres email nie zostanie opublikowany. Pola, których wypełnienie jest wymagane, są oznaczone symbolem *

Witryna wykorzystuje Akismet, aby ograniczyć spam. Dowiedz się więcej jak przetwarzane są dane komentarzy.