Malicious Office (OOXML) / .XLSX — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Private Sub Workbook_Open()

'Snima kopiju tabele pri otvaranju samo ako je nastala izmena u odnosu na prethodo snimanje
Dim path As String, bookPathName As String, NameINI As String
Dim SavePath As String
Dim DatumVremeP As Date, DatumVremePString As String
Dim DatumVremeS As Date, DatumVremeSString As String

bookPathName = ThisWorkbook.FullName
path = Mid(bookPathName, 1, InStrRev(bookPathName, "\")) + "ARP SIGNAL Auto BackUp\"
NameINI = "FileCount.ini"
'da li postoji folder
If Dir(path, vbDirectory) = "" Then MkDir path
'da li postoji fajl. ako ne postoji napravi ga
If Dir(path + NameINI) = "" Then
    'napravi fajl
    Open path + NameINI For Output As #1
    Print #1, CDate(0)
    Close #1
End If

'fajl postoji. Proveri da li je sadrzaj fajla validan
Open path + NameINI For Input As #1
'da li je duzina veca ili manja od unapred odredjene."Input past end of file"
duzina = LOF(1)
Close #1
If (duzina > 30) Or (duzina < 10) Then
    'duzina fajla nije dobra. napravi novi fajl
    Open path + NameINI For Output As #1
    Print #1, CDate(0)
    Close #1
End If

'duzina fajla je dobra. procitaj sadrzaj i proveri da li je u datumskom formatu
Open path + NameINI For Binary As #1 'ovde se koristi Binary jer ako se fajl otvori sa Input a u fajlu su
Input #1, DatumVremePString          'upisane samo nule onda javlja gresku prilikom citanja
Close #1
If Not IsDate(DatumVremePString) Then
    'ako nije datum onda upisi novu vrednost
    Open path + NameINI For Output As #1
    Print #1, CDate(0)
    Close #1
End If

'konacno ucitaj datum u string i prebaci ga u daumski format
Open path + NameINI For Input As #1
Input #1, DatumVremePString
Close #1
DatumVremeP = DatumVremePString

'ucitaj datum zadnje modifikacije ove radne knjige
DatumVremeS = ThisWorkbook.BuiltinDocumentProperties.Item("Last Save Time")
DatumVremeSString = Format(DatumVremeS, "dd.mm.yyyy. h\hmm'ss''")

'ucitaj datum zadnje modifikacije zadnje snimljene knjige pre ove
Open path + NameINI For Input As #1
Input #1, DatumVremePString
Close #1
DatumVremeP = DatumVremePString

If DatumVremeS <> DatumVremeP Then
    SavePath = path + DatumVremeSString + " ARP SIGNAL stanje u magacinu.xlsm"
    'kopiraj ovu radnu knjigu
    Application.ThisWorkbook.SaveCopyAs SavePath
    Open path + NameINI For Output As #1
    Print #1, DatumVremeS
    Close #1
End If

End Sub

Private Sub Workbook_Activate()

'Ovde se definisu nasa slova za koriscenje u menijima u MsgboxW funkciji
ch = ChrW(&H10D)
chBig = ChrW(&H10C)
sh = ChrW(&H161)
shBig = ChrW(&H160)
zr = ChrW(&H17E)
zrBig = ChrW(&H17D)
dj = ChrW(&H111)
djBig = ChrW(&H110)
tj = ChrW(&H107)
tjBig = ChrW(&H106)

'Menus ("add")
End Sub

Private Sub Workbook_Deactivate()
'Menus ("delete")
End Sub


Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Worksheet_Activate()
'Menus ("add")
End Sub

Private Sub Worksheet_Deactivate()
'Menus ("delete")
End Sub


Attribute VB_Name = "PP"
Option Explicit

Const CustomMenuName = "ARP SIGNAL"

'blokiranje dvostrukog uzastopnog pozivanja pp:MeniAkcija
Public Blokiranje As Boolean

'prva i zadnja kolona sa opisom komponente
Public FirstCompCol As Long, LastCompCol As Long

'prva i zadnja kolona sa opisom ploca
Public FirstPCBCol As Long, LastPCBCol As Long

'kolona sa formulama za stanje u magacinu
Public StateCol As Long

'nulta (ona koja se ne brise) kolona sa rezervacijama
Public NullReservationCol As Long

'prva i zadnja kolona sa rezervacijama
Public FirstReservationCol As Long, LastReservationCol As Long

'Prva i prva prazna kolona za promet u magacinu
Public FirstTrafficCol As Long, FirstEmptyTrafficCol As Long

'Redni broj kolone za desgnator (oznaka na ploci) u opisu ploce
Public DesignatorCol As Long

'Redni broj kolone za broj komada u opisu ploce
Public QuantityCol As Long

'Prvi red zaglavlja u tabeli (ne racunajuci glagni naslov)
Public FirstTableRow As Long

'Prvi i zadnji red sa komponentama
Public FirstCompRow As Long, LastCompRow As Long

'Red u koji se upisuje broj ploca koje treba da se rade i red sa nazivima ploca
Public PCBNumberRow As Long, PCBNameRow As Long

'Red u kome se upisuje datum i promet u magacinu
Public TrafficDateRow As Long

'Red u kome se upisuje naziv ploce koja je radjena ili opis prometa
Public TrafficNameRow As Long

'Red u kome se upisuje broj komada ploca koja je radjena
Public TrafficNumberRow As Long

'Red u kome se upisuju nazivi kolona za opis jedne ploce Npr: "Oznaka", "Kom" ...
Public PCBColsDescriptionRow As Long

'Broj kolona za opis jedne ploce
Public ColNumberPerPCB As Long

Public ch As String, chBig As String
Public tj As String, tjBig As String
Public sh As String, shBig As String
Public zr As String, zrBig As String
Public dj As String, djBig As String

Public Odgovor As Variant 'moze i broj i string
Dim SelRed As Long 'selektovan red

Public SpisakPloca() As String

Public SpisakKomponenata() As String

Public MeniPutanje() As String

Public stOdnosiGlobal As String

Public Nereaguj As Boolean

Public Izbor As String

Public Putanja As Variant

Public Const Mname As String = "MyPopUpMenu"

Public TNaziv As Long, TVrednost As Long, TKuciste As Long, TProizvodjac As Long, TFarnell As Long

Public brojKomponente As Long

Public Specifikacija As Object, SP As Worksheet

Public SFirstCompRow As Long, SLastCompRow As Long

Public POznaka As Long, PKom As Long, SPutanja As String

Public SKom As Long, SOznaka As Long, SKuciste As Long, SVrednost As Long, SFarnell As Long

Public IzabranaPlocaZaUpis As Long


Public stGloCelaSifra As String

Public Const CellsDelimiter As String = "  "

Private Const BirVrednost = 1
Private Const BirKuciste = 2
Private Const BirFarnell = 3
Private Const BirARPNaziv = 4
Private Const BirARPVrednost = 5
Private Const BirARPKuciste = 6
Private Const BirARPFarnell = 7
Private Const Biranje = 8
Private Const BirPrviRed = 1

'Ovde se deklarise funkcija koja omogucava srpska slova u MessageBoxu
Private Declare Function User32MsgBox Lib "user32" Alias "MessageBoxW" _
    (Optional ByVal hWnd As Long, Optional ByVal Prompt As Long, _
     Optional ByVal Title As Long, Optional ByVal Buttons As Long) As Long

'Ovde se definise format funkcije koja omogucava srpska slova u MessageBoxu
Public Function MsgBoxW(cPrompt As String, _
    Optional cButtons As VbMsgBoxStyle = vbOKOnly, _
    Optional cTitle As String) As Long

    MsgBoxW = User32MsgBox(0, StrPtr(cPrompt), StrPtr(cTitle), cButtons)

End Function

Public Function GetTableDim() As Boolean
'*******************************
'Ovaj pp analizira polozaj i sadrzaj tabele i puni promenljive
'koje opisuju lokaciju pojedinih delova tabele iz kojih se
'uzimaju podaci radi analize i obrade i drugim potprogramima.
'*******************************
Dim Nasao As Boolean, red As Long, kol As Long, Spojene As String
Dim Nastavak As Long, Reper As Range
GetTableDim = False

'*******************************
'Ovaj deo pp trazi rec 'komponente'. To je prvi deo tabele.
'Ova rec mora da se nalazi u prvoj koloni tabele, s tim da
'prva kolona tabele ne mora da bude i prva kolona radnog lista
'vec moze da bude u rasponu od 1-10. kolone i od 1-10. reda
'*******************************
'Trazi "Komponente"
For red = 1 To 10
For kol = 1 To 10
If LCase(Trim(Cells(red, kol))) = "komponente" Then
    Nasao = True
    Exit For
End If
Next kol
If Nasao Then Exit For
Next red
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em zaglavlje tabele (re" + ch + ": 'Komponente')", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
FirstCompCol = kol
FirstTableRow = red

'*******************************
'Ovaj deo pp trazi rec 'stanje'. To je drugi deo tabele.
'Ova rec mora da se nalazi u prvoj koloni podtabele, s tim da
'moze da se koristi Merge komanda 1. reda te podtabele radi lepseg izgleda.
'*******************************
'Trazi "stanje"
Nasao = False
For kol = FirstCompCol + 1 To FirstCompCol + 16000
If InStr(1, LCase(Trim(Cells(red, kol))), "stanje") <> 0 Then
    Nasao = True
    Exit For
End If
Next kol
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em zaglavlje tabele (re" + ch + ": 'Stanje')", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
StateCol = kol
LastCompCol = kol - 1

'*******************************
'Ovaj deo pp trazi rec 'ploce'. To je treci deo tabele.
'Ova rec mora da se nalazi u prvoj koloni podtabele, s tim da
'moze da se koristi Merge komanda 1. reda te podtabele radi lepseg izgleda.
'*******************************
'Trazi "Ploce"
Nasao = False
For kol = FirstCompCol + 1 To FirstCompCol + 10
If InStr(1, LCase(Trim(Cells(red, kol))), "plo") <> 0 Then
    Nasao = True
    Exit For
End If
Next kol
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em zaglavlje tabele (re" + ch + ": 'Plo" + ch + "e')", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
FirstPCBCol = kol

'*******************************
'Ovaj deo pp trazi rec 'rezervacije'. To je cetvrti deo tabele.
'Ova rec mora da se nalazi u prvoj koloni podtabele, s tim da
'moze da se koristi Merge komanda 1. reda te podtabele radi lepseg izgleda.
'*******************************
'Trazi "rezervacije"
Nasao = False
For kol = FirstPCBCol + 1 To FirstPCBCol + 16000
If InStr(1, LCase(Trim(Cells(red, kol))), "rezervacije") <> 0 Then
    Nasao = True
    Exit For
End If
Next kol
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em zaglavlje tabele (re" + ch + ": 'Rezervacije')", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
NullReservationCol = kol
LastPCBCol = kol - 1

'*******************************
'Ovaj deo pp trazi rec 'promet'. To je peti deo tabele.
'Ova rec mora da se nalazi u prvoj koloni podtabele, s tim da
'moze da se koristi Merge komanda 1. reda te podtabele radi lepseg izgleda.
'*******************************
'Trazi "Promet"
Nasao = False
For kol = FirstPCBCol + 1 To FirstPCBCol + 16000
If InStr(1, LCase(Trim(Cells(red, kol))), "promet") <> 0 Then
    Nasao = True
    Exit For
End If
Next kol
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em zaglavlje tabele (re" + ch + ": 'Promet')", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
FirstTrafficCol = kol

If FirstTrafficCol - NullReservationCol = 1 Then
    FirstReservationCol = 0
    LastReservationCol = 0
Else
    FirstReservationCol = NullReservationCol + 1
    LastReservationCol = FirstTrafficCol - 1
End If

'*******************************
'Ovaj deo pp trazi rec 'naziv'. on mora da se nalazi najvise 10 redova
'ispod reci 'komponente'.
'*******************************
'Trazi "Naziv"
Nasao = False
For red = red + 1 To red + 10
If InStr(1, LCase(Trim(Cells(red, FirstCompCol))), "naziv") <> 0 Then
    Nasao = True
    Exit For
End If
Next red
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em zaglavlje pottabele (re" + ch + ": 'Promet')", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If

'*******************************
'Sada preskace sve prazne redove ispod reci 'naziv' i trazi pocetak
'liste komponenata.
'*******************************
'Trazi prvi red komponente
Nasao = False
For red = red + 1 To red + 10
For kol = FirstCompCol To LastCompCol
If Trim(Cells(red, kol)) <> "" Then
    Nasao = True
    Exit For
End If
Next kol
If Nasao Then Exit For
Next red
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em po" + ch + "etak tabele (bar jednu stavku u opisu komponente)", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
FirstCompRow = red

'*******************************
'Sada trazi zadnji red sa opisom komponente. Dovoljno je da postoji
'bar jedna stavka u opisima komponente pa da se to racuna kao opis.
'Dozvoljeno je i da ima najvise 10 praznih redova u opisima komponente.
'*******************************
'Trazi zadnji red komponente
Nastavak = FirstCompRow + 1
Do
Nasao = False
For red = Nastavak To FirstCompRow + 4000
Spojene = ""
For kol = FirstCompCol To LastCompCol
Spojene = Spojene + CStr(Cells(red, kol))
Next kol
If Trim(Spojene) = "" Then
    Nasao = True
    Exit For
End If
Next red
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em kraj tabele (bar jedan prazan red u opisu komponente)", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
LastCompRow = red - 1

'Da li ispod zadnje kolone komponenata ima jos neka
'(najveci dozvoljeni razmak je 10 redova)
Nasao = False
For red = LastCompRow + 1 To LastCompRow + 10
Spojene = ""
For kol = FirstCompCol To LastCompCol
Spojene = Spojene + CStr(Cells(red, kol))
Next kol
If Trim(Spojene) <> "" Then
    Nasao = True
    Exit For
End If
Next red
Nastavak = red + 1
Loop While Nasao

'*******************************
'Sada trazi zadnju kolonu sa opisom prometa. Dovoljno je da postoji
'bar jedna stavka u opis prometa pa da se to racuna kao opis.
'Ignorisu se one kolone koje imaju ispunjeno zaglavlje u opisu prometa
'a nemaju ni jednu stavku u listi opisa. Ovde obratiti paznju prilikom
'automatskog popunjavanja prometa za vise od jednu plocu. Tada se upisivanje
'vrsi u uzastopnim kolonama i ako je jedna medjukolona prazna onda ce da
'bude upisano i preko sledece iako je puna. To moze da se resi
'tako sto ce da se poziva GetTableDim pre svakog upisivanja u kolonu promet
'u okviru istog pp. Jer ovaj pp trazi samo prvu slobodnu a ne sve slobodne.
'Moze da se desi da je prva slobodna 25. kolona a da 26. nije!
'*******************************
'Trazi zadnju kolonu "Promet"
For kol = FirstTrafficCol To 16000
Nasao = True ' nasao praznu kolonu
For red = FirstCompRow - 3 To LastCompRow
If Trim(Cells(red, kol)) <> "" Then
    Nasao = False
    Exit For
End If
Next red
If Nasao Then Exit For
Next kol
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em kraj podtabele 'Promet' (bar jedna prazna kolona)", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
FirstEmptyTrafficCol = kol

'*******************************
'Pocevsi od prvog reda iznad liste komponenata pa na gore,
'pretrazujuci kolone sa nazivima ploca trazi da sve celije u istom redu
'ili budu prazne ili imaju numericke vrednosti.
'*******************************
'Trazi red gde se upisuje broj ploca za rad
Nasao = False
For red = FirstCompRow - 1 To FirstTableRow + 1 Step -1
Nastavak = 0
For kol = FirstPCBCol To LastPCBCol
If Trim(Cells(red, kol)) = "" Or IsNumeric(Cells(red, kol)) Then
    Nastavak = Nastavak + 1
End If
Next kol
If Nastavak = LastPCBCol - FirstPCBCol + 1 Then
    Nasao = True
    Exit For
End If
Next red
If Not Nasao Then
    MsgBoxW "Ne mogu da na" + dj + "em mesto za upisivanje broja plo" + ch + "a (u pottabeli 'Plo" + ch + "e')", vbCritical, _
           "Error in GetTableDim"
    Exit Function
End If
PCBNumberRow = red
PCBNameRow = FirstTableRow + 1
TrafficDateRow = FirstCompRow - 1
TrafficNameRow = FirstCompRow - 3
TrafficNumberRow = FirstCompRow - 2
ColNumberPerPCB = 2

DesignatorCol = 1
QuantityCol = 2 'ovo znaci da druga kolona u opisu ploce sadrzi broj komada komponenti

PCBColsDescriptionRow = TrafficDateRow

'Ovo se ne racuna vec se pretpostavlja da je tako
DesignatorCol = 1
QuantityCol = 2

'*******************************
'Vraca vrednost True ako je provera ispravno protekla i to znaci da su
'sve promenljive dobile validne vrednosti.
'Vraca vrednost False ako se desila greska u toku provere i ne treba
'koristiti vrednosti tih promenljivih.
'*******************************
GetTableDim = True
End Function

Sub Menus() 'add_del As String)

'*******************************
'Ovaj pp ubacuje staticne stavke menija i podmenija.
'Ostale aktivne stavke se ubacuju tek po pozivu te aktivne stavke menija.
'*******************************

'Dim cMenu1 As CommandBarControl
'Dim cbMainMenuBar As CommandBar
'Dim cbcCustomMenu As CommandBarControl
'Dim cbcCustomSubMenu As CommandBarControl
Dim Meni(9, 5) As String
Dim X As Integer, Y As Integer, a$, duzina As Integer, sifra As Integer, odnosi As Integer
Dim Tip As Long, Akcija As String, iTag As String
Dim stSifra As String, stOdnosi As String
Dim Nav As String, CelaSifra As String
Nav = Chr(34)

'Definisanje stavki u meniju:
'Pravila za definisanje stavki u meniju:
'Mogu da postoje najvise 2 nivoa podmenija
'x,0 je 1. nivo podmenija
'x,1 x,2 x,3 ... su 2. nivo podmenija x,0
'Cetvorocifreni broj na kraju svake stavke predstavlja 2 dvocifrena broja
'od kojih prvi,ako je 01 ili 02 oznacava sadrzaj popup menija a drugi 'sifra'
'argument u OnAction propertiesu potprograma MeniAkcija (vidi PP:MeniAkcija)
'ako je prvi broj razlicit od 01 i 02 onda je to 'sifra' argument OnAction menija
'dok drugi broj nije bitan i stavlja se da bude 00.

Meni(1, 0) = "Dodaj plo" + ch + "u" + "000000"
    Meni(1, 1) = "Ispred" + "001009"
    Meni(1, 2) = "Iza" + "001010"
    Meni(1, 3) = "Uz asistenciju" + "023000"
Meni(2, 0) = "Izbri" + sh + "i plo" + ch + "u" + "001011"
Meni(3, 0) = "Dodaj komponentu" + "000000"
    Meni(3, 1) = "Ispred selektovanog reda" + "020000"
    Meni(3, 2) = "Na selektovanom redu" + "021000"
    Meni(3, 3) = "Iza selektovanog reda" + "022000"
Meni(4, 0) = "Dodaj promet u magacinu" + "019000"
Meni(5, 0) = "Prika" + zr + "i" + "000000"
    Meni(5, 1) = "Specifikaciju za" + "001012"
    Meni(5, 2) = "Izmene za" + "001013"
    Meni(5, 3) = "Plo" + ch + "e koje se rade" + "003000"
    Meni(5, 4) = "Promene u magacinu" + "002014"
    Meni(5, 5) = "Sve" + "004000"
Meni(6, 0) = "Rezervi" + sh + "i plo" + ch + "u(e)" + "016000"
Meni(7, 0) = "Uradi plo" + ch + "u(e)" + "005000"
Meni(8, 0) = "Uradi rezervaciju" + "017018" '17-sifra za ubacivanje spiska rezervisanih ploca u meni,18-sifra komande za izvrsavanje komande rezervacije
Meni(9, 0) = "Izve" + sh + "taj" + "000000"
    Meni(9, 1) = "Stanje u magacinu" + "015000"
    Meni(9, 2) = shBig + "ta nedostaje" + "006000"
    Meni(9, 3) = "Specifikacija za" + "001007"
    Meni(9, 4) = "Promene u magacinu" + "002008"


ReDim MeniPutanje(18)
MeniPutanje(9) = "Dodaj plo" + ch + "u" + " > " + "Ispred"
MeniPutanje(10) = "Dodaj plo" + ch + "u" + " > " + "Iza"
MeniPutanje(11) = "Izbri" + sh + "i plo" + ch + "u"
MeniPutanje(12) = "Prika" + zr + "i" + " > " + "Specifikaciju za"
MeniPutanje(13) = "Prika" + zr + "i" + " > " + "Izmene za"
MeniPutanje(7) = "Izve" + sh + "taj" + " > " + "Specifikacija za"
MeniPutanje(14) = "Prika" + zr + "i" + " > " + "Promene u magacinu"
MeniPutanje(8) = "Izve" + sh + "taj" + " > " + "Promene u magacinu"
MeniPutanje(18) = "Uradi rezervaciju"


'*******************************
'Ovaj deo pp postoji za svaki slucaj da obrise zaostali meni iz prethodnog
'otvaranja tabele. To moze da se desi ako se srusi excel ili ako dodje do
'greske u radu makroa ili ako je aktivirana pauza makroa pre izlaska iz tabele
'Zato postoji On Error jer pokusaj brisanja nepostojece stavke izaziva gresku.
'*******************************
'obrisi stari meni CustomMenuName
'On Error Resume Next
'Application.CommandBars("Worksheet Menu Bar").Controls(CustomMenuName).Delete
'On Error GoTo 0

'*******************************
'Ako je argument 'delete' onda je brisanje menija zadnje sto treba da se uradi.
'Ako nije onda treba da ubaci staticne stavke menija.
'*******************************
'If LCase(add_del) = "delete" Then Exit Sub

'uzmi referencu na Menu Bar
'Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")

'dodaj meni sa nazivom Meni(0,0)
'Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
'    cbcCustomMenu.Caption = CustomMenuName
Dim cbcCustomMenu As CommandBar
Dim cbcCustomSubMenu As CommandBarControl
Set cbcCustomMenu = CommandBars.Add(Name:=CustomMenuName, Position:=msoBarPopup, _
                                     MenuBar:=False, Temporary:=True)

For X = 1 To UBound(Meni, 1)
For Y = 0 To UBound(Meni, 2)
a$ = Meni(X, Y)
If a$ = "" Then Exit For
duzina = Len(a$)

CelaSifra = Mid(a$, duzina - 5)
sifra = Left(CelaSifra, 3)


a$ = Left(a$, duzina - 6)

Select Case sifra
Case 0
    Tip = msoControlPopup
    Akcija = ""
Case 1, 2, 17
    Tip = msoControlPopup
    Akcija = "MeniAkcija"
Case Else
    Tip = msoControlButton
    Akcija = "MeniAkcija"
End Select

If Y = 0 Then
    'dodaj glavni podmeni
        Set cbcCustomSubMenu = cbcCustomMenu.Controls.Add(Type:=Tip)
        cbcCustomSubMenu.Caption = a$
        cbcCustomSubMenu.OnAction = Akcija
        cbcCustomSubMenu.Tag = CelaSifra
Else
    'dodaj pomocni podmeni
        With cbcCustomSubMenu.Controls.Add(Type:=Tip)
            .Caption = a$
            .OnAction = Akcija
            .Tag = CelaSifra
        End With
End If

Next Y
Next X

End Sub

Public Sub MeniAkcija(CelaSifra As String)

Dim cbMainMenuBar As CommandBar
Dim cbcCustomMenu As CommandBarControl
Dim cbcCustomSubMenu As CommandBarControl
Dim sifra As Integer, stSifra As String
Dim odnosi As Integer, stOdnosi As String
Dim rbrPloce As String, Akcija As String, i As Long, j As Long
Dim kol As Long, red As Long, a$, b$, c$
'Dim CelaSifra As String
Dim a1 As Integer, b1 As Integer, c1 As Integer, Razlika As Long
Dim Nasao As Boolean
Dim BrojacRadeSe As Integer, BrojRadeSe As Integer
Dim Prva As Integer, Zadnja As Integer
Dim Potrebno() As Single, StanjePosle() As Single
Dim cel1 As Object, cel2 As Object
Dim zaUpis As Single
Dim PomString As String, PomNumber As Long
Dim MeniPutanja As String
Dim Izabrana As Long

ReDim MeniPutanje(27)
MeniPutanje(9) = "Dodaj plo" + ch + "u" + " > " + "Ispred"
MeniPutanje(10) = "Dodaj plo" + ch + "u" + " > " + "Iza"
MeniPutanje(11) = "Izbri" + sh + "i plo" + ch + "u"
MeniPutanje(12) = "Prika" + zr + "i" + " > " + "Specifikaciju za"
MeniPutanje(13) = "Prika" + zr + "i" + " > " + "Izmene za"
MeniPutanje(7) = "Izve" + sh + "taj" + " > " + "Specifikacija za"
MeniPutanje(14) = "Prika" + zr + "i" + " > " + "Promene u magacinu"
MeniPutanje(8) = "Izve" + sh + "taj" + " > " + "Promene u magacinu"
MeniPutanje(18) = "Uradi rezervaciju"
MeniPutanje(24) = "Prona" + dj + "i plo" + ch + "u"
MeniPutanje(26) = "Prona" + dj + "i komponentu"
MeniPutanje(27) = "Izve" + sh + "taj" + " > " + "Promet komponente"

'CelaSifra = CommandBars.ActionControl.Tag

stSifra = Left(CelaSifra, 3)
sifra = CInt(stSifra)
stOdnosi = Right(CelaSifra, 3)
odnosi = CInt(stOdnosi)
If sifra = 1 Or sifra = 2 Or sifra = 17 Or sifra = 25 Then MeniPutanja = "ARP SIGNAL > " + MeniPutanje(odnosi) + " > "

If Not GetTableDim Then Exit Sub

ReDim Potrebno(LastCompRow), StanjePosle(LastCompRow)

Select Case sifra
Case 1
    'Dodaj nove stavke
    frmSpisakPloca.lstSpisak.Clear
    frmSpisakPloca.Height = GetScreenHeight - 100
    frmSpisakPloca.Top = 50
    frmSpisakPloca.Left = GetScreenWidth \ 2 - frmSpisakPloca.Width \ 2 ' GetXCursorPos + 50
    frmSpisakPloca.lstSpisak.Height = frmSpisakPloca.Height - 100
    frmSpisakPloca.cboFilter.AddItem "ARP07"
    frmSpisakPloca.cboFilter.AddItem "ARP08"
    frmSpisakPloca.cboFilter.AddItem "ARP09"
    frmSpisakPloca.cboFilter.AddItem "ARP10"
    frmSpisakPloca.cboFilter.AddItem "ARP11"
    frmSpisakPloca.cboFilter.AddItem "ARP12"
    frmSpisakPloca.cboFilter.AddItem "ARP13"
    frmSpisakPloca.cboFilter.AddItem "ARP14"
    frmSpisakPloca.lblMeniPutanja.Caption = MeniPutanja
    MeniPutanja = ""
    
    stOdnosiGlobal = stOdnosi
    ReDim SpisakPloca((LastPCBCol - FirstPCBCol) \ ColNumberPerPCB)
    i = 0
    For kol = FirstPCBCol To LastPCBCol Step ColNumberPerPCB
    a$ = Cells(PCBNameRow, kol)
    a1 = InStr(1, a$, Chr(10))
    If a1 <> 0 Then Mid(a$, a1, 1) = " "
    
    SpisakPloca(i) = a$
    i = i + 1
    frmSpisakPloca.lstSpisak.AddItem a$
    Next kol
    frmSpisakPloca.lblNadjeno.Caption = i

    frmSpisakPloca.Show


Case 2
    'Napravi spisak promena u magacinu i ubaci ih u meni .parameter=Sifra sa OnActiom svojstvom Odnosi
    'Prvo obrisi postojece stavke
    'Set cbcCustomMenu = CommandBars.FindControls(Tag:=CelaSifra).Item(1)
    'For i = cbcCustomMenu.Controls.Count To 1 Step -1
    'cbcCustomMenu.Controls.Item(i).Delete
    'Next i
    
    frmPromRez.lstSpisak.Clear
    'frmPromRez.Height = GetScreenHeight - 100
    frmPromRez.Top = 50
    frmPromRez.Left = GetXCursorPos + 50
    'frmPromRez.lstSpisak.Height = frmSpisakPloca.Height - 100
    frmPromRez.lblMeniPutanja.Caption = MeniPutanja
    MeniPutanja = ""
    
    stOdnosiGlobal = stOdnosi
    
    'Onda dodaj nove stavke
    Razlika = FirstEmptyTrafficCol - FirstTrafficCol
    If Razlika > 15 Then Razlika = 15
    For kol = FirstEmptyTrafficCol - 1 To FirstEmptyTrafficCol - Razlika Step -1
        
    'datum
    a$ = Trim(Cells(TrafficDateRow, kol))
    If a$ <> "" Then
        a1 = InStr(1, a$, Chr(10))
        If a1 <> 0 Then Mid(a$, a1, 1) = " "
        
        a1 = Len(a$)
        If Mid(a$, a1, 1) = "." Then Mid(a$, a1, 1) = " "
        a$ = Format(a$, "dd.mm.yyyy.")
    End If
    
    'naziv
    b$ = Trim(Cells(TrafficNameRow, kol))
    If b$ <> "" Then
        For i = 1 To Len(b$)
        b1 = InStr(i, b$, Chr(10))
        If b1 <> 0 Then Mid(b$, b1, 1) = " "
        i = i + b1
        Next i
    End If
    
    'komada
    c$ = Trim(Cells(TrafficNumberRow, kol))
    If c$ <> "" Then
        c1 = InStr(1, c$, Chr(10))
        If c1 <> 0 Then Mid(c$, c1, 1) = " "
        If c$ <> "" Then c$ = "(" + c$ + " kom.)"
    End If
    
    'rbrPloce = Format(FirstEmptyTrafficCol - Kol, "000")
    'Akcija = "MeniAkcija"
    
    If a$ + b$ + c$ <> "" Then
    
        frmPromRez.lstSpisak.AddItem a$ + " " + b$ + " " + c$

        'With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
        '    .Caption = a$ + " " + b$ + " " + c$
        '    .OnAction = Akcija
        '    .Tag = stOdnosi + rbrPloce
        'End With
    
    End If
    
    Next kol
    
    frmPromRez.Show

Case 17
'Ubaci spisak rezervacija u meni
    'Napravi spisak rezervacija i ubaci ih u meni .parameter=Sifra sa OnActiom svojstvom Odnosi
    'Prvo obrisi postojece stavke
    Dim NasilniIzlaz As Boolean, Ubaci As String
    NasilniIzlaz = False
    'Set cbcCustomMenu = CommandBars.FindControls(Tag:=CelaSifra).Item(1)
    'For i = cbcCustomMenu.Controls.Count To 1 Step -1
    'cbcCustomMenu.Controls.Item(i).Delete
    'Next i
    frmPromRez.lstSpisak.Clear
    'frmPromRez.Height = GetScreenHeight - 100
    frmPromRez.Top = 50
    frmPromRez.Left = GetXCursorPos + 50
    'frmPromRez.lstSpisak.Height = frmSpisakPloca.Height - 100
    frmPromRez.lblMeniPutanja.Caption = MeniPutanja
    MeniPutanja = ""
    
    stOdnosiGlobal = stOdnosi
    
    'Proveri da li postoje rezervisane ploce
    If FirstReservationCol = 0 Then
        a$ = "< nema rezervacija >"
        b$ = ""
        c$ = ""
        Akcija = ""
        stOdnosi = ""
        rbrPloce = ""
        NasilniIzlaz = True
    End If
    'Onda dodaj nove stavke
    Razlika = LastReservationCol - FirstReservationCol
    If Razlika > 15 Then Razlika = 15
    'If Razlika = 0 Then Razlika = 1
    For kol = LastReservationCol To LastReservationCol - Razlika Step -1
    If Not NasilniIzlaz Then
        'datum
        a$ = Trim(Cells(TrafficDateRow, kol))
        If a$ <> "" Then
            a1 = InStr(1, a$, Chr(10))
            If a1 <> 0 Then Mid(a$, a1, 1) = " "
            
            a1 = Len(a$)
            If Mid(a$, a1, 1) = "." Then Mid(a$, a1, 1) = " "
            a$ = Format(a$, "dd.mm.yyyy.")
        End If
        
        'naziv
        b$ = Trim(Cells(TrafficNameRow, kol))
        If b$ <> "" Then
            For i = 1 To Len(b$)
            b1 = InStr(i, b$, Chr(10))
            If b1 <> 0 Then Mid(b$, b1, 1) = " "
            i = i + b1
            Next i
        End If
        
        'komada
        c$ = Trim(Cells(TrafficNumberRow, kol))
        If c$ <> "" Then
            c1 = InStr(1, c$, Chr(10))
            If c1 <> 0 Then Mid(c$, c1, 1) = " "
            If c$ <> "" Then c$ = "(" + c$ + " kom.)"
        End If
            rbrPloce = Format(LastReservationCol - kol + 1, "000")
            Akcija = "MeniAkcija"
    End If

    If a$ + b$ + c$ <> "" Then
    frmPromRez.lstSpisak.AddItem a$ + " " + b$ + " " + c$

        'With cbcCustomMenu.Controls.Add(Type:=msoControlButton)
        '    Ubaci = a$ + " " + b$ + " " + c$
        '    If Len(Ubaci) > 255 Then Ubaci = Mid(Ubaci, 1, 255)
        '    .Caption = Ubaci
        '    .OnAction = Akcija
        '    .Tag = stOdnosi + rbrPloce
        'End With
    
    End If
    If NasilniIzlaz Then Exit For
    Next kol
    
    frmPromRez.Show
    
Case 25
'Dodaj nove stavke u Form Pronadji komponentu
    frmSpisakKomponenata.lstSpisak.Clear
    frmSpisakKomponenata.Height = GetScreenHeight - 100
    frmSpisakKomponenata.Top = 50
    frmSpisakKomponenata.Left = GetScreenWidth \ 2 - frmSpisakKomponenata.Width \ 2 ' GetXCursorPos + 50
    frmSpisakKomponenata.lstSpisak.Height = frmSpisakKomponenata.Height - 100
    frmSpisakKomponenata.cboFilter.AddItem "Otpornik"
    frmSpisakKomponenata.cboFilter.AddItem "Kondenzator"
    frmSpisakKomponenata.cboFilter.AddItem "Tranzistor"
    frmSpisakKomponenata.cboFilter.AddItem "Integrisano kolo"
    frmSpisakKomponenata.cboFilter.AddItem "Optokapler"
    frmSpisakKomponenata.cboFilter.AddItem "Induktivnost"
    frmSpisakKomponenata.cboFilter.AddItem "Elektrolit"
    frmSpisakKomponenata.cboFilter.AddItem "LED"
    frmSpisakKomponenata.cboFilter.AddItem "Dioda"
    frmSpisakKomponenata.cboFilter.AddItem "Zener"
    frmSpisakKomponenata.cboFilter.AddItem "Grec"
    frmSpisakKomponenata.cboFilter.AddItem "Varistor"
    frmSpisakKomponenata.cboFilter.AddItem "Konektor"
    frmSpisakKomponenata.lblMeniPutanja.Caption = MeniPutanja
    MeniPutanja = ""
    
    stOdnosiGlobal = stOdnosi
    ReDim SpisakKomponenata(LastCompRow - FirstCompRow)
    i = 0
    For red = FirstCompRow To LastCompRow
        a$ = ""
        For j = FirstCompCol To LastCompCol
            a$ = a$ + CStr(Cells(red, j)) + CellsDelimiter
        Next j
    
    SpisakKomponenata(i) = a$
    i = i + 1
    frmSpisakKomponenata.lstSpisak.AddItem a$
    Next red
    frmSpisakKomponenata.lblNadjeno.Caption = i

    frmSpisakKomponenata.Show


Case 3
    'Prvo proveri da li se radi bar jedna ploca
    Nasao = False
    For kol = FirstPCBCol To LastPCBCol Step ColNumberPerPCB
    If Cells(PCBNumberRow, kol) <> 0 Then
        Nasao = True
        Exit For
    End If
    Next kol
    If Not Nasao Then
        MsgBoxW "Trenutno se ne radi ni jedna plo" + ch + "a"
        Exit Sub
    End If
    'Posto ima ploca koje se rade, sakrij prvo kolone, a onda i komponente
    'koji se ne pojavljuju u plocama koje se rade
    'Prvo otkrij sve
    UnhideAll
    Dim RadeSe() As Integer
    ReDim RadeSe(LastPCBCol - FirstPCBCol)
    BrojRadeSe = 0
    For kol = FirstPCBCol To LastPCBCol Step ColNumberPerPCB
    If Cells(PCBNumberRow, kol) = 0 Then
        Range(Columns(kol), Columns(kol + ColNumberPerPCB - 1)).Hidden = True
    Else
        BrojRadeSe = BrojRadeSe + 1
        RadeSe(BrojRadeSe) = kol
    End If
    Next kol
    'Sad sakrij ceo promet u magacinu
    Range(Columns(FirstTrafficCol), Columns(FirstEmptyTrafficCol - 1)).Hidden = True
    'Sad sakrij komponente (redove) koje se ne pojavljuju u plocama koje se rade
    For red = FirstCompRow To LastCompRow
    Nasao = False
    For BrojacRadeSe = 1 To BrojRadeSe
    For i = RadeSe(BrojacRadeSe) To RadeSe(BrojacRadeSe) + ColNumberPerPCB - 1
    If Trim(Cells(red, i)) <> "" Then
        Nasao = True
        Exit For
    End If
    Next i
    If Nasao Then Exit For
    Next BrojacRadeSe
    If Not Nasao Then Rows(red).Hidden = True
    Next red

Case 4
    UnhideAll
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
    
Case 5
'Uradi plocu(e)
    'Uradi ploce (sa raspolozivim brojem komponenata). Uzmi iz magacina
…