meerdere excel files linken naar 1 bestand met macro's

[arjoderoon]

ik heb een hele lijst met bestanden die in principe allemaal dezelfde macro's bevatten. Als er nu iets moet wijzigen, moet ik iedere keer in ieder bestand de code gaan wijzigen dus ik had al bedacht dat het vast mogelijk zou moeten zijn om dit in 1 bestand op te slaan en alle bestanden aan dat ene bestand te linken.

Ik heb gezocht en vond dat je een xlam kunt maken waarin de codes opgeslagen zijn en waaraan gelinkt kan worden.

Ik heb alle code die nodig was gekopieerd en in een nieuwe workbook in de vba editor geplakt en vervolgens het bestand als xlam opgeslagen.


Alleen, hoe zorg ik er nu voor dat ik de code (ik zal de volledige code die ik wil plakken hieronder zetten) dat deze vanuit de andere bestanden nu aangeroept kan worden? Moet ik daarvoor bij ieder bestand ervoor zorgen dat de xlam als invoegtoepassing is geselecteerd? Of kan ik in de code ook een linkje maken naar het bestand?)

Sub vernieuwalles()


Call NITRO.RefreshDataAllWorksheets
Call datawissen


ThisWorkbook.Save

End Sub
Sub datawissen()


Application.ScreenUpdating = False


With Sheets("schaduwblad")
.Cells.ClearContents

End With


Application.ScreenUpdating = True

Call dataplaatsen

End Sub


Sub dataplaatsen()

Application.ScreenUpdating = False
Sheetnames = Array("food-drug", "food-drug (2)", "aswatson", "aswatson (2)", "food", "food (2)")

For i = LBound(Sheetnames) To UBound(Sheetnames)
    With Sheets(Sheetnames(i))
        .Range(.Range("U2"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("Schaduwblad").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
Next i
     

Application.ScreenUpdating = True


Call kolomtitels



End Sub

Sub kolomtitels()

With Sheets("schaduwblad")
    Sheets("food-drug").Range("a1", "F1").Copy Sheets("schaduwblad").Range("A1", "F1")
       
.[g1].Value = "4w periode -2"
.[h1].Value = "4w periode -1"
.[i1].Value = "4w periode"
.[j1].Value = "--"
.[k1].Value = "Last 12 wks -2"
.[l1].Value = "Last 12 wks -1"
.[m1].Value = "Last 12 wks 0"
.[n1].Value = "--"
.[o1].Value = "YTD-2"
.[p1].Value = "YTD-1"
.[q1].Value = "YTD-0"
.[r1].Value = "--"
.[s1].Value = "MAT-2"
.[t1].Value = "MAT-1"
.[u1].Value = "MAT-0"
.[v1].Value = "waarde 4w positief"
.[w1].Value = "waarde 12w positief"
.[x1].Value = "waarde YTD positief"
.[y1].Value = "waarde MAT positief"
.[z1].Value = "merk ja/nee"
.[aa1].Value = "item ja/nee"


End With

Call toevoegen


End Sub

Sub toevoegen()


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Worksheets("schaduwblad")
    For Each cel In .Range(.[a2], .[a1000000].End(xlUp))
        For i = 0 To 3
            If cel.Offset(0, 8 + i * 4) > 0 Then
                cel.Offset(0, 21 + i) = "ja"
            Else
                cel.Offset(0, 21 + i) = "nee"
            End If
        Next i
        
        If cel.Offset(0, 3) = "" Then
            cel.Offset(0, 25) = "nee"
        Else
            cel.Offset(0, 25) = "ja"
        End If
        
        If cel.Offset(0, 4) = "" Then
            cel.Offset(0, 26) = "nee"
        Else
            cel.Offset(0, 26) = "ja"
        End If
    Next cel

End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Call maaktabel


End Sub

Sub maaktabel()
  
Dim rLastCell As Range

With Sheets("schaduwblad")

Set rLastCell = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'MsgBox ("The last used column is: " & rLastCell.Address)

     'Maak tabel gewoon bereik
    '.ListObjects("Tabel3").Unlist

    .ListObjects.Add(xlSrcRange, .Range("A1", rLastCell.Address), _
                                 , xlYes).Name = "Tabel3"
                                 
  
                                 
End With



End Sub

Sub Change_slicers()

'---changes source data of pivots connected to specified slicers
Dim dicPivotIDs As Object
Dim vSlicers() As Variant, vSlicerList() As Variant, vKey As Variant
Dim PT As PivotTable, PT1 As PivotTable
Dim sPivotID As String, sNewSource As String
Dim iSlicer As Long, iPivot As Long, lItem As Long

'--edit list of slicers. They must share the same PivotCache.
'     they don't need to be connected to the same PivotTables
vSlicerList = Array("Slicer_FCT1", "Slicer_PROD", "Slicer_MKT", "Slicer_MERK_GEZ1")

'--edit with range reference to new PivotCache datasource
On Error GoTo ErrHandler
'  example1: reference an existing Named Range with Workbook scope
'sNewSource = "MyPivotData"
'  example2: reference an existing Table (ListObject)
sNewSource = "Tabel3"
'  example3: other range reference
'sNewSource = Sheets("Sheet1").Range("A1").CurrentRegion.Address

Set dicPivotIDs = CreateObject("Scripting.Dictionary")
ReDim vSlicers(LBound(vSlicerList) To UBound(vSlicerList))

'--build array of arrays mapping each Slicer's connected PivotTables
For iSlicer = LBound(vSlicerList) To UBound(vSlicerList)
   With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer))
      If .PivotTables.Count Then
         ReDim vPivots(1 To .PivotTables.Count)
         For Each PT In .PivotTables
            iPivot = iPivot + 1
            Set vPivots(iPivot) = PT
            '--add unique pivot identifiers to dictionary
            sPivotID = "'" & PT.Parent.Name & "'!" & _
               PT.TableRange1.Cells(1).Address
            If Not dicPivotIDs.Exists(sPivotID) Then
               lItem = lItem + 1
               dicPivotIDs.Add sPivotID, lItem
            End If
            '--disconnect from slicer
            .PivotTables.RemovePivotTable (PT)
         Next PT
         vSlicers(iSlicer) = vPivots
         iPivot = 0
      End If
   End With
Next iSlicer

'---change datasource of all pivots
For Each vKey In dicPivotIDs.Keys
   If PT1 Is Nothing Then
      Set PT1 = Range(vKey).PivotTable

      PT1.ChangePivotCache _
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:=sNewSource)
   Else
      Range(vKey).PivotTable.CacheIndex = PT1.CacheIndex
   End If
Next vKey

'--reconnect Pivots to Slicers using stored mapping
For iSlicer = LBound(vSlicers) To UBound(vSlicers)
   If Not IsEmpty(vSlicers(iSlicer)) Then
      With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
         For iPivot = LBound(vSlicers(iSlicer)) To UBound(vSlicers(iSlicer))
            .AddPivotTable vSlicers(iSlicer)(iPivot)
         Next iPivot
      End With
   End If
Next iSlicer

MsgBox "The PivotTables' data source have been updated"

Exit Sub
ErrHandler:
   MsgBox Err.Number & ": " & Err.Description
   
 
  
End Sub


Sub select4wk()

Application.Goto Sheets("Dashboard 4wks period").ScrollRow = 11

End Sub

Sub select12wk()

Application.Goto Sheets("Dashboard 12wks period").ScrollRow = 11

End Sub
Sub selectYTD()

Application.Goto Sheets("Dashboard YTD").ScrollRow = 11


End Sub
Sub selectMAT()

Application.Goto Sheets("Dashboard MAT").ScrollRow = 11

End Sub
Sub Printsheets()

ActiveSheet.PrintOut



End Sub

Sub deletesheet()


Application.DisplayAlerts = False

ThisWorkbook.Unprotect Password:="TM"

Sheets("samenvoeging").Delete

ThisWorkbook.Unprotect Password:="TM"
Application.DisplayAlerts = True

ThisWorkbook.Save

End Sub

Sub list_Pivots()

 Dim pvt As PivotTable
 Dim iSht As Long
 Dim iRow As Integer

 Application.ScreenUpdating = False
 Set objnewsheet = Worksheets.Add
 objnewsheet.Activate

 iRow = 2
 iSht = 2

 'SET TITLES
 Range("A1").FormulaR1C1 = "Name"
 Range("B1").FormulaR1C1 = "Source"
 Range("C1").FormulaR1C1 = "Refreshed by"
 Range("D1").FormulaR1C1 = "Refreshed"
 Range("E1").FormulaR1C1 = "Sheet"
 Range("F1").FormulaR1C1 = "Location"

 'GET PIVOT DETAILS
For Each Worksheet In Worksheets
 For Each pvt In Worksheet.PivotTables
 objnewsheet.Cells(iRow, 1).Value = pvt.Name
 objnewsheet.Cells(iRow, 2).Value = pvt.SourceData
 objnewsheet.Cells(iRow, 3).Value = pvt.RefreshName
 objnewsheet.Cells(iRow, 4).Value = pvt.RefreshDate
 objnewsheet.Cells(iRow, 5).Value = Worksheet.Name
 objnewsheet.Cells(iRow, 6).Value = pvt.TableRange1.Address
 iRow = iRow + 1
Next


Next

 objnewsheet.Activate

 Application.ScreenUpdating = True

 End Sub

Sub MultiplePivotSlicerCaches()

    Dim oSlicer As Slicer
    Dim oSlicercache As SlicerCache
    Dim oPT  As PivotTable
    Dim oSh As Worksheet
       
    Set objnewsheet = Worksheets.Add
    objnewsheet.Activate
 
 iRow = 1
 


    For Each oSlicercache In ThisWorkbook.SlicerCaches
        For Each oPT In oSlicercache.PivotTables
            objnewsheet.Cells(iRow, 1) = oSlicercache.Name
            objnewsheet.Cells(iRow, 2) = oPT.Name
            objnewsheet.Cells(iRow, 3) = oPT.Parent.Name
            iRow = iRow + 1
        Next
    Next


End Sub

hierin maak ik al gebruik van een invoegtoepassing, namelijk nitro.xlam. in principe worden alle templates die ik gemaak standaard geopent met een verwijzing naar nitro.xlam, dus dat is gedekt.

 

[wampier]

Je kunt je xlam plaatsen in:

c:\program files(x86)\microsoft office\office12\xlstart

Locatie en directories natuurlijk afhankelijk van je persoonlijke situatie en office versie.

 

[arjoderoon]

dank. En als ik het bestand centraal neer wil zetten op het netwerk voor alle gebruikers?

om de nitro.xlam te kunnen gebruiken moet ik in de vba editor via verwijzingen nitro aanvinken.

Een vergelijkbaar iets zal ik nu ook moeten doen lijkt mij, maar ik kan de door mij opgeslagen xlam niet vinden in het lijstje met mogelijke verwijzingen dat de vba editor geeft.

 

[wampier]

Je kunt je XLAM vinden onder de naam van het VBA project dat in die file zit. Dus als je project in je XLAM file "MijnProject" heet, kun je die toevoegen via "MijnProject" in de referenties.

Nitro moet ook met de hand, tenzij de "applications extensibility" referentie standaard is meegegeven in je omgeving (onwaarschijnlijk).

Ik ben niet zo'n held op het gebied van office deployment over het netwerk, dus ik weet niet of hier tools voor zijn.

 

[arjoderoon]

is het mogelijk om zonder koppeling via invoegtoepassingen, het bestand te draaien?

ik had application.run {naam van bestand!sub naam}

dat werkte maar ik krijg nu melding dat de macro niet in mijn documenten staat.

de template die ik open wordt natuurlijk in mijn tijdelijke bestanden opgeslagen en die staan natuurlijk onder mijn documenten.


Daarom probeer ik een alternatief te vinden. het xlam bestand staat in dezelfde map als de templates.

ik dacht daarom iets te doen met activeworkbook.path maar dat werkt helaas niet.

de template en de xlam staan allebei in de volgende map:
M:\commercie\marktdata\segment ontwikkeling

hoe kan ik ervoor zorgen dat er altijd naar de juiste locatie gelinkt wordt (ook als er in de toekomst bestanden verplaatsen)?


ik had nu als code:

application.run(thisworkbook.path & "\nielsen_refresh.xlam!vernieuwalles")

maar dan krijg ik een 1004 error:

De macro M:\Commercie\Marktdata\Segment ontwikkeling\nielsen_refresh.xlam!vernieuwalles kan niet worden uitgevoerd.
De macro is wellicht niet beschikbaar in dit werkblad of alle macro's zijn uitgeschakeld.

het pad en de bestandsnaam kloppen.

De macro heb ik ook zo genoemd.

het enige wat nog mee zou kunnen spelen is dat ik het bestand nielsen_refresh.xlam verborgen heb gemaakt zodat de gewone gebruikers het bestand niet zien er dingen mee kunnen doen.



wat gaat er verkeerd of moet ik iets anders doen?

 

[snb]

Vertel eerst eens waarom je het zonder 'invoegtoepassingen' (dat voor wat jij wil expliciet ontworpen is) wil doen ?

 

[arjoderoon]

euh...goede vraag. ik heb daarover nagedacht. Het was niet onderbouwd maar meer op de vraag of de addin bij alle gebruikers automatisch gekoppeld zou zijn.

Daarom was het (dacht ik) het makkelijkste om het zonder de add-in aan te zetten in excel en dmv application.run de macro aan te roepen.

dat werkte eerst, maar daarna bij een volgend bestand kreeg ik de error.

 

[snb]

Gebruik wat ervoor is ontworpen: addins.

Een addin is nooit automatisch geladen, maar moet door een gebruiker geladen worden (dat kan evt. ook met een gedistribueerde macro).

 

[arjoderoon]

Als ik de addin laad in het bestand en deze opsla. wordt de add-in dan voor alle gebruikers van het bestand geladen?

 

[snb]

Een addin is niet gekoppeld aan een bestand maar aan de toepassing (Excel).
Zoals ik in mijn vorige post zei moet iedere gebruiker een addin laden.

 

[pixcel]

Maak twee bestanden MyApp.xlsm en MyLib.xlsm.
In de workbook.open van MyApp kijk je of MyLib al geladen is, zo niet dan laad je hem.
Nu kun je vanuit MyApp elke public macro in MyLib callen mbv Application.Run.
Bij afsluiten van MyApp sluit je ook MyLib (let op, addertje onder het gras).

MyLib staat dus in dienst van MyApp. Of, zo je wilt, is gekoppeld aan MyApp.

Maak nu van MyLib een addin: simpelweg opslaan als MyLib.xlam. Alles blijft hetzelfde, met één verschil: voor de gebruiker is in de userinterface MyLib niet meer zichtbaar.

Een addin is niets anders dan een onzichtbaar workbook. Het is een methode om je logica te scheiden van data en userinterface.

 

[arjoderoon]

Dank voor je hulp. Je hebt het over een addertje onder het gras.
Wat is dit addertje?

 

[pixcel]

Bijv als je meerdere apps hebt die van MyLib gebruik maken. Daar moet MyLib tegen kunnen, en alleen de eerste MyApp mag MyLib sluiten.
Ler er trouwens ook op dat application.run je error handler breekt. Als je in MyApp een error handler zet en in MyLib ontstaat een fout dan wordt je MyApp errorhandler niet geactiveerd.

 

[arjoderoon]

oke... bedankt ik moet dus nog een hoop leren zie ik al om dit soort dingen aan te kunnen. Cursus VBA zou niet gek zijn.

Ik heb onderstaande macro voor het automatisch installeren van addins:

Private Sub Workbook_open()
    
    Dim myAddIn As AddIn
    
    ' Load and install new XLAM
    Set myAddIn = Application.AddIns.Add("M:\commercie\marktdata\nielsen\xlam\segment_ontwikkeling.xlam")
    myAddIn.Installed = True
    
    ' Load known XLAM
    For Each myAddIn In AddIns
        If myAddIn.Name = "segment_ontwikkeling.xlam" Then
            myAddIn.Installed = False
            myAddIn.Installed = True
        End If
    Next

deze installeert nu 1 addin. (maar ik wil er nog 1 in hebben zodat de beide benodigde koppelingen allebei actief zijn).
Kan ik die er gewoon bij zetten in een regel eronder?

daarnaast krijg ik nu iedere keer bij het openen onderstaande melding:


Kan ik die melding omzeilen?

https://www.dropbox.com/s/q3qtwlgz0b9yn5f/macro kopieren.png

 

[arjoderoon]

Update:

door mijn beperkte kennis van vba merk ik nu dat mijn gedachte mooi was maar de uitvoering te wensen over liet.
Mijn volledige script werkt niet merk ik.

Daarom zoek ik hulp van iemand die mij wil helpen om dit goed op te zetten...

Ik wil een xlam die ervoor zorgt dat er in een andere xlsm de activiteiten uitgevoerd worden die in de eerste post staan:
1. door een koppeling aan nitro.xlam wordt met een code alle data bijgewerkt
2. vervolgens wordt door een koppeling aan een andere xlam onderstaande uitgevoerd:

Sub vernieuwalles()


Call datawissen


ThisWorkbook.Save

End Sub

Sub datawissen()


Application.ScreenUpdating = False


With Sheets("schaduwblad")
.Cells.ClearContents

End With


Application.ScreenUpdating = True

Call dataplaatsen

End Sub


Sub dataplaatsen()

Application.ScreenUpdating = False
Sheetnames = Array("food-drug", "food-drug (2)", "aswatson", "aswatson (2)", "food", "food (2)")

For i = LBound(Sheetnames) To UBound(Sheetnames)
    With Sheets(Sheetnames(i))
        .Range(.Range("U2"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("Schaduwblad").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
Next i
     

Application.ScreenUpdating = True


Call kolomtitels



End Sub

Sub kolomtitels()

With Sheets("schaduwblad")
    Sheets("food-drug").Range("a1", "F1").Copy Sheets("schaduwblad").Range("A1", "F1")
       
.[g1].Value = "4w periode -2"
.[h1].Value = "4w periode -1"
.[i1].Value = "4w periode"
.[j1].Value = "--"
.[k1].Value = "Last 12 wks -2"
.[l1].Value = "Last 12 wks -1"
.[m1].Value = "Last 12 wks 0"
.[n1].Value = "--"
.[o1].Value = "YTD-2"
.[p1].Value = "YTD-1"
.[q1].Value = "YTD-0"
.[r1].Value = "--"
.[s1].Value = "MAT-2"
.[t1].Value = "MAT-1"
.[u1].Value = "MAT-0"
.[v1].Value = "waarde 4w positief"
.[w1].Value = "waarde 12w positief"
.[x1].Value = "waarde YTD positief"
.[y1].Value = "waarde MAT positief"
.[z1].Value = "merk ja/nee"
.[aa1].Value = "item ja/nee"


End With

Call toevoegen


End Sub

Sub toevoegen()


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Worksheets("schaduwblad")
    For Each cel In .Range(.[a2], .[a1000000].End(xlUp))
        For i = 0 To 3
            If cel.Offset(0, 8 + i * 4) > 0 Then
                cel.Offset(0, 21 + i) = "ja"
            Else
                cel.Offset(0, 21 + i) = "nee"
            End If
        Next i
        
        If cel.Offset(0, 3) = "" Then
            cel.Offset(0, 25) = "nee"
        Else
            cel.Offset(0, 25) = "ja"
        End If
        
        If cel.Offset(0, 4) = "" Then
            cel.Offset(0, 26) = "nee"
        Else
            cel.Offset(0, 26) = "ja"
        End If
    Next cel

End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Call maaktabel


End Sub

Sub maaktabel()
  
Dim rLastCell As Range

With Sheets("schaduwblad")

Set rLastCell = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

'MsgBox ("The last used column is: " & rLastCell.Address)

     'Maak tabel gewoon bereik
    '.ListObjects("Tabel3").Unlist

    .ListObjects.Add(xlSrcRange, .Range("A1", rLastCell.Address), _
                                 , xlYes).Name = "Tabel3"
                                 
  
                                 
End With



End Sub

na het doorlopen hiervan moet in het bestand zelf alle draaitabellen bijgewerkt worden en het bestand vervolgens worden opgeslagen.

Alleen is de code van de xlam nu zo dat de bewerkingen in de xlam uitgevoerd worden. Dat werkt dus niet helaas.


Wie wil mij helpen hierbij?

 

[pixcel]

Ik wil een xlam die ervoor zorgt dat er in een andere xlsm de activiteiten uitgevoerd worden die in de eerste post staan

Ik denk dat je een xlam wilt (met al je code) en een xlsX (met data, draaitabellen, gegevensverbindingen, etc). De addin installeert evt een userinterface en voert opdrachten uit op de xlsx, die is lijdend voorwerp.
Zo wordt de addin meestal gebruikt.