Code:
Sub Sifra_NazivKonta()
Dim rng As Range
Dim DefaultRange As Range
Dim iCol As Long
Dim br As Long
Dim bk As Long
Dim PathNameSifarnikC As String
Dim PathNameSifarnikD As String
Dim PathNameSifarnikE As String
Dim PathNameSifarnikF As String
Dim PathNameSifarnikG As String
Dim PathNameSifarnikH As String
Dim owb As Workbook
Dim Sifarnik As Workbook
Dim fso As Object
Dim FindKonto As String
Dim RedKonta As Long
Dim SifarnikKonta As Range
On Error Resume Next
Set owb = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx")
On Error GoTo 0
Set fso = CreateObject("Scripting.FileSystemObject")
'Provera na kojoj se particiji nalazi sifarnik
PathNameSifarnikC = "C:\sifarnik"
PathNameSifarnikD = "D:\sifarnik"
PathNameSifarnikE = "E:\sifarnik"
PathNameSifarnikF = "F:\sifarnik"
PathNameSifarnikG = "G:\sifarnik"
PathNameSifarnikH = "H:\sifarnik"
If owb Is Nothing Then
If fso.FolderExists(PathNameSifarnikC) And fso.GetDrive("C:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("C:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikD) And fso.GetDrive("D:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("D:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikE) And fso.GetDrive("E:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("E:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikF) And fso.GetDrive("F:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("F:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikG) And fso.GetDrive("G:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("G:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikH) And fso.GetDrive("H:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("H:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
Else
MsgBox "Nemate sifarnik konta, u excel-u. Kreirajte folder sifarnik i prebacite u njega fajl Pravilnik o stand klas okviru i k plan.xlsx", vbOKOnly
Exit Sub
End If
Else
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
End If
'Determine a default range based on user's Selection
If TypeName(Selection) = "Range" Then
Set DefaultRange = Selection
Else
Set DefaultRange = ActiveCell
End If
'Get A Cell Address From The User to Get Number Format From
On Error Resume Next
Set rng = Application.InputBox( _
Title:="Opseg izbora konta", _
Prompt:="Izaberi kolonu, gde su smestena konta, u formatu A1:A5", _
Default:=DefaultRange.Address, _
Type:=8)
'to get the number of columns that you want to insert with an input box
'iCount = InputBox(Prompt:="Unesite broj kolona za unos?", Default:=1)
'to get the column number where you want to insert the new column
iCol = InputBox _
(Prompt:= _
"Iza koje kolone zelite da unesete kolonu(e), broj kolone u formatu: 1,2,3...? ")
'insert new column(s)
Columns(iCol).EntireColumn.Offset(, 1).Insert
' RAD SA KONTIMA
Cells(1, iCol + 1).Value = "Konto i Naziv"
On Error GoTo 0
'Test to ensure User Did not cancel
If rng Is Nothing Then Exit Sub
'Opseg selektovane kolone
rng.Select
'Opseg sifarnika Konto
'Petlja koja omogucava pomeranje kroz tekucu tabelu
bk = iCol + 1
For br = rng.Row To rng.Row + rng.Rows.Count + 1
'Pronalazenje sifre konta u Sifarniku i ubacivanje konto+naziv konta u tekucu tabelu
Select Case Len(ActiveSheet.Cells(br, rng.Column).Value)
Case Is = 2
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("J:J").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
Case Is = 3
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("G:G").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
Case Is = 4
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("D:D").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
Case Is = 6
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("A:A").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
End Select
Next br
ActiveSheet.Columns(iCol + 1).EntireColumn.AutoFit
ActiveSheet.Columns(iCol + 1).HorizontalAlignment = xlLeft
End Sub
Sub Sifra_NazivKonta()
Dim rng As Range
Dim DefaultRange As Range
Dim iCol As Long
Dim br As Long
Dim bk As Long
Dim PathNameSifarnikC As String
Dim PathNameSifarnikD As String
Dim PathNameSifarnikE As String
Dim PathNameSifarnikF As String
Dim PathNameSifarnikG As String
Dim PathNameSifarnikH As String
Dim owb As Workbook
Dim Sifarnik As Workbook
Dim fso As Object
Dim FindKonto As String
Dim RedKonta As Long
Dim SifarnikKonta As Range
On Error Resume Next
Set owb = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx")
On Error GoTo 0
Set fso = CreateObject("Scripting.FileSystemObject")
'Provera na kojoj se particiji nalazi sifarnik
PathNameSifarnikC = "C:\sifarnik"
PathNameSifarnikD = "D:\sifarnik"
PathNameSifarnikE = "E:\sifarnik"
PathNameSifarnikF = "F:\sifarnik"
PathNameSifarnikG = "G:\sifarnik"
PathNameSifarnikH = "H:\sifarnik"
If owb Is Nothing Then
If fso.FolderExists(PathNameSifarnikC) And fso.GetDrive("C:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("C:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikD) And fso.GetDrive("D:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("D:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikE) And fso.GetDrive("E:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("E:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikF) And fso.GetDrive("F:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("F:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikG) And fso.GetDrive("G:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("G:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
ElseIf fso.FolderExists(PathNameSifarnikH) And fso.GetDrive("H:\").DriveType = 2 Then
Set Sifarnik = Workbooks.Open("H:\sifarnik\Pravilnik o stand klas okviru i k plan.xlsx")
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
Else
MsgBox "Nemate sifarnik konta, u excel-u. Kreirajte folder sifarnik i prebacite u njega fajl Pravilnik o stand klas okviru i k plan.xlsx", vbOKOnly
Exit Sub
End If
Else
'Postavljanje ovog workbook-a da je aktivan
ThisWorkbook.Activate
End If
'Determine a default range based on user's Selection
If TypeName(Selection) = "Range" Then
Set DefaultRange = Selection
Else
Set DefaultRange = ActiveCell
End If
'Get A Cell Address From The User to Get Number Format From
On Error Resume Next
Set rng = Application.InputBox( _
Title:="Opseg izbora konta", _
Prompt:="Izaberi kolonu, gde su smestena konta, u formatu A1:A5", _
Default:=DefaultRange.Address, _
Type:=8)
'to get the number of columns that you want to insert with an input box
'iCount = InputBox(Prompt:="Unesite broj kolona za unos?", Default:=1)
'to get the column number where you want to insert the new column
iCol = InputBox _
(Prompt:= _
"Iza koje kolone zelite da unesete kolonu(e), broj kolone u formatu: 1,2,3...? ")
'insert new column(s)
Columns(iCol).EntireColumn.Offset(, 1).Insert
' RAD SA KONTIMA
Cells(1, iCol + 1).Value = "Konto i Naziv"
On Error GoTo 0
'Test to ensure User Did not cancel
If rng Is Nothing Then Exit Sub
'Opseg selektovane kolone
rng.Select
'Opseg sifarnika Konto
'Petlja koja omogucava pomeranje kroz tekucu tabelu
bk = iCol + 1
For br = rng.Row To rng.Row + rng.Rows.Count + 1
'Pronalazenje sifre konta u Sifarniku i ubacivanje konto+naziv konta u tekucu tabelu
Select Case Len(ActiveSheet.Cells(br, rng.Column).Value)
Case Is = 2
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("J:J").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
Case Is = 3
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("G:G").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
Case Is = 4
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("D:D").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
Case Is = 6
FindKonto = ActiveSheet.Cells(br, rng.Column).Value
Set SifarnikKonta = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Columns("A:A").Find(What:=FindKonto, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not SifarnikKonta Is Nothing Then
RedKonta = SifarnikKonta.Row
Cells(br, bk).Value = Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 1).Value & " - " & Workbooks("Pravilnik o stand klas okviru i k plan.xlsx").Sheets("Po nivoima konta").Cells(RedKonta, 2).Value
End If
End Select
Next br
ActiveSheet.Columns(iCol + 1).EntireColumn.AutoFit
ActiveSheet.Columns(iCol + 1).HorizontalAlignment = xlLeft
End Sub
Medjutim, pojavljuje se problem, zelim da se ovaj makro prikazuje u svim workbookovima. Snimio sam ga kao Personal!Imemogmakroa.xlsb i kad ga pokrenem preko dugmeta u ribbonu, ne radi, kao da ne zna iz kog workbook-a se pokrece