Obdelava vseh zvezkov v mapi

Vsi se srečujemo s situacijami, ko moramo pripravljati poročila za celo leto. V primeru, da imamo posamezne zvezke za določeno leto v isti mapi, nam zelo koristi manjša VBA skripta. Nastavljena je tako, da nam odpre vse delovne zvezke (workbooks) v določeni mapi (folder). Vanjo vstavimo še tisti del, ki nam podatke obdela. Nato jih skripta shrani in zapre.

Ker so Application.ScreenUpdating, Application.DisplayAlerts in Application.EnableEvents nastavljena na FALSE, nam na zaslonu nič ne poskakuje med izvajanje. Če bi pa radi izpadli bolj "geekovsko", preprosto nastavimo vse na TRUE oz. pobrišemo dotične vrstice.

Sub porocilo()
'ce ne dela moras dat reference microsoft word object

'Dimi za word
Dim wrdApp As Word.Application
Dim xlsAPP As Excel.Application

'Dimi za odpiranje vseh excelovih datotek v mapi
Dim lCount As Long
Dim wbResult As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

'ustvari objekt MS Word. Odpre se program MS WORD
Set wrdApp = CreateObject("Word.Application.12")
    wrdApp.Visible = True
  
    'Ustvari nov Wordov dokument
    wrdApp.Documents.Add

'odpiranje vseh excelovih datotek v mapi
On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            'Spremeni pot, da ustreza
            .LookIn = "\delo"
            .FileType = msoFileTypeExcelWorkbooks
            'Pogojni filter za vremenske datoteke
            .Filename = "wd*.xls"
                If .Execute > 0 Then 'za delovne zvezke v mapi
                    For lCount = 1 To .FoundFiles.Count 'loopa skozi vse
                        'odpri zvezek x in ji priredi spremenljivko Workbook
                        Set wbResult = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                      
                        'tukaj bo koda za izdelavo vseh potrebnih grafov in tabel
                      
                      
                      
                        'in seveda še zaključek multiplega odpiranja zvezkov
                        wbResult.Close SaveChanges:=False
                    Next lCount
                End If
            End With
        On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
  
End Sub