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