Bosna i Hercegovina



#1 04.08.2017-09:31
Avko Offline
Administrator
Registrovan/a od: 28.05.2014-09:21
Komentari: 2,758


Subject: direktorij ucitavanja je direktorij excel fajla
DownloadIzvorni kod (Text):
  1. Sub proba()
  2.     Dim wsCopy As Worksheet
  3.     Dim rngCopy As Range
  4.     Dim wbPaste As Workbook
  5.     Dim wsPaste As Worksheet
  6.     Dim rngPaste As Range
  7.        
  8.     aktivniList = ActiveSheet.Name
  9.    
  10.     ChDir ActiveWorkbook.Path 'odredivanje direktorija u kojem se nalazi excel datoteka sa procedurom
  11.    
  12.     FileToOpen = Application.GetOpenFilename _
  13.                 (Title:="izaberi datoteku za uvoz podataka", _
  14.                 FileFilter:="prihvacene extenzije *.xls (*.xlsm),")
  15.    
  16.     If FileToOpen = False Then
  17.         'ako datoteka nije izabrana
  18.         MsgBox "Nije izabrana datoteka.", vbExclamation, "ERROR"
  19.         Exit Sub
  20.     Else
  21.         'ako je datoteka izabrana
  22.        
  23.         imeFajla = GetFilenameFromPath(FileToOpen) 'ime datoteke koju smo uzeli
  24.        
  25.         Set wbPaste = ActiveWorkbook
  26.         Set wbCopy = Workbooks.Open(FileToOpen)
  27.         Set wsCopy = wbCopy.Worksheets("Sheet1")
  28.    
  29.         zadnjiRed = traziZadnjiRed("Sheet1", 1)
  30.         zadnjaKolona = traziZadnjuKolonu("Sheet1")
  31.    
  32.         Set rngCopy = wsCopy.Range(Cells(1, 1), Cells(zadnjiRed, zadnjaKolona))
  33.         Set wsPaste = wbPaste.Worksheets(aktivniList)  'shit u koji idu podaci
  34.         Set rngPaste = wsPaste.Range("A1")  'pocinje od celije A1
  35.    
  36.         rngCopy.Copy
  37.         rngPaste.PasteSpecial
  38.    
  39.         Workbooks.Application.CutCopyMode = False
  40.    
  41.         Filename = ActiveWorkbook.Name
  42.         Workbooks(Filename).Close
  43.     End If
  44. End Sub
  45.  
  46. Function traziZadnjiRed(ImeSita As String, kolona)
  47.     Dim Zadnji As Long
  48.     Dim ws As Worksheet
  49.    
  50.     Set ws = Sheets(ImeSita)
  51.     With ws
  52.         Zadnji = .Cells(.Rows.Count, kolona).End(xlUp).Row
  53.     End With
  54.     traziZadnjiRed = Zadnji
  55. End Function
  56.  
  57. Function traziZadnjuKolonu(ImeSita As String)
  58.     Dim Zadnji As Long
  59.     Dim ws As Worksheet
  60.     Dim zadnjaCelija As Range
  61.    
  62.     Set ws = Sheets(ImeSita)
  63.    
  64.     Set zadnjaCelija = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
  65.                                     LookAt:=xlPart, SearchOrder:=xlByColumns, _
  66.                                     SearchDirection:=xlPrevious, MatchCase:=False)
  67.    
  68.     Zadnji = zadnjaCelija.Column
  69.     traziZadnjuKolonu = Zadnji
  70. End Function
  71.  
  72. Function GetFilenameFromPath(ByVal strPath As String) As String
  73.     ' npr. 'c:\winnt\win.ini' vraca 'win.ini'
  74.  
  75.     If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
  76.         GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
  77.     End If
  78. End Function

sa ovom gore procedurom kopiram shit iz neke excel datoteke u otvorenu excel datoteku. Problem je u tome kada dode do getFileOpen ponudi mi direktorij u kojem se ne nalazi ova datoteka pa moram rucno doci do fajla kojeg zelim ucitati. Fajl koji zelim ucitati nalazi se u istom folderu gdje se nalazi i ovaj fajl iz kojeg radi ova procedura.

Pitanje: kako postaviti putanju za ucitavanje onu u kojoj se nalazi i excel fajl, tj. ova procedura.
Newton laže! Lake padaju brže!
Ovaj komentar je mijenjan 1 puta. zadnja izmjena 04.08.2017-09:39 od strane Avko. ↑  ↓

#2 04.08.2017-15:12
dex Offline
Super Moderator
Registrovan/a od: 23.02.2012-19:59
Komentari: 556


Ocjena: Ocjena:100 Subject: Re: direktorij ucitavanja je direktorij excel fajla
Umesto

ChDir ActiveWorkbook.Path

stavi
Application.DefaultFilePath = Application.ThisWorkbook.Path
↑  ↓

#3 08.08.2017-07:02
Avko Offline
Administrator
Registrovan/a od: 28.05.2014-09:21
Komentari: 2,758


Subject: Re: direktorij ucitavanja je direktorij excel fajla
Hvala dex to je to
Newton laže! Lake padaju brže!
↑  ↓

Stranice (1): 1


All times are GMT +01:00. Current time: 23.11.2017-19:30.