[ 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
[ gogi100 @ 09.05.2022. 07:15 ] @
Pokusao sam da koristim

Code:
ActiveWorkbook.Activate


umesto

Code:
ThisWorkbook.Activate


makro radi kad je workbook Pravilnik o stand klas okviru i k plan.xlsx vec otvoren. Medjutim, kada nije i kada se prvi put otvara, ne radi
[ gogi100 @ 09.05.2022. 07:34 ] @
kako da postavim aktivan workbook, odakle je pokrenut makro?
[ Jpeca @ 09.05.2022. 08:04 ] @
Preporučujem ti da snimiš tu radnu svesku sa makroom kao Excel add-in. ( Save as ...)

Kad otvoriš novu (postojeću) radnu svesku, omogući taj add in Developer > Add-ins > Excel Add-ins. i kasnjie ga možeš ga koristiti u svakoj radnoj sveci.

Vidi detealjnije