[ gogi100 @ 09.05.2022. 06:43 ] @
imam makro, koji radi dobro. Makro je 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 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 |