Foutmelding bij opvragen macro vanuit ander bestand

Status
Niet open voor verdere reacties.
onnokramer

onnokramer

Gebruiker
Lid geworden
2 feb 2011
Berichten
12
Hallo,

Als ik een macro opvraag vanuit een andere bestand (PE_dp_hand v1.15.xlsm) krijg ik een foutmelding:

Fout 9 tijdens uitvoering, het subscript valt buiten het bereik.
Blijkbaar loopt hij hier op vast "Sheets("Calc").Activate"
Maar het vreemde is dat deze (PE_dp_hand v1.15.xlsm) los wel het goed doet?

Kan iemand mij helpen?
bedankt
Code: 
Sub Menu()
    ' --------------------------------------------------------------------------------
    ' | Initialisatie.
    ' --------------------------------------------------------------------------------
    
    ' Application.DisplayAlerts = False ' Meldingen (fouten bijv) uit.
    
    curpath = ThisWorkbook.Path                     'Huidige directory.
    Dim MenuFilename1 As String                     'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim MenuFilename2 As String                     'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim MenuFilename3 As String                     'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim MenuFilenameFull1 As String                 'Idem met path.
    Dim MenuFilenameFull2 As String                 'Idem met path.
    Dim MenuFilenameFull3 As String                 'Idem met path.
    
    Sheets("Menu").Activate
    MenuFilename1 = Range("MenuFilename1").Value    ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    MenuFilename2 = Range("MenuFilename2").Value    ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    MenuFilename3 = Range("MenuFilename3").Value    ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    MenuFilenameFull1 = curpath & "" & MenuFilename1
    MenuFilenameFull2 = curpath & "" & MenuFilename2
    MenuFilenameFull3 = curpath & "" & MenuFilename3
    
    Application.Run ("'" & MenuFilenameFull1 & "'!test1")
    Application.Run ("'" & MenuFilenameFull2 & "'!test2")
    Application.Run ("'" & MenuFilenameFull3 & "'!Results_Data_dp_Vis_Zeef")
    
    Workbooks(MenuFilename1).Close
    Workbooks(MenuFilename2).Close
    Workbooks(MenuFilename3).Close
    
    ' Application.Run ("'" & workbookname & "'!macroname")
    ' Application.Run ("'Analytics macro S17.xlsm'!getdata")
    ' Workbooks(Filename).Close
    
    ' Workbooks.Open (FilenameFull) ' Open resultaten bestand.
    ' Application.Run "Results_Data_dp_Vis_Zeef"
    ' Workbooks(Filename).Close

End Sub

Sub Results_Data_dp_vis_zeef()
    ' --------------------------------------------------------------------------------
    ' | Initialisatie.
    ' --------------------------------------------------------------------------------
    
    Application.Calculation = xlAutomatic   ' Automatisch rekenen aan.
    Application.DisplayAlerts = False       ' Meldingen (fouten bijv) uit.
    
    Dim i, j, x, y As Long
    Dim Array1() As Variant
    
    curpath = ThisWorkbook.Path             'Huidige directory.
    Dim Filename As String                  'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim FilenameFull As String              'Idem met path.
    
    ' Definieren van je matrix.
    ReDim Array1(14, 16)                    '14 = aantal dagen, 2x8=16 aantal rijen, aantal te onthouden resultaten.
    
    ' --------------------------------------------------------------------------------
    ' | Initieren data resultaten bestand.
    ' --------------------------------------------------------------------------------
    
    Sheets("Calc").Activate
    Filename = Range("Filename").Value      ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    FilenameFull = curpath & "" & Filename
    
    y = Range("start").Row
    x = Range("start").Column
    
    For i = 1 To 14 'y
        For j = 1 To 16 'x
            Array1(i, j) = Cells(y + i - 1, x + j - 1)
        Next j
    Next i
    
    Workbooks.Open (FilenameFull)           ' Open resultaten bestand.
    y = Range("start_dp_vis_zeef").Row
    x = Range("start_dp_vis_zeef").Column
    
    Sheets("data").Activate
    For i = 1 To 14
        For j = 1 To 16
            Cells(i - 1 + y, x + j - 1) = Array1(i, j)
        Next j
    Next i
    
    ActiveWorkbook.SaveAs Filename:=(FilenameFull) 'Bestand met resultaat opslaan.
    Workbooks(Filename).Close

End Sub


*mod edit*

Beste onnokramer,

Ik heb de code even in code blokken gezet. Dit kunt u zelf doen voortaan door de code te selecteren en dan in de optiebalk op het hekje te drukken :)
 
Laatst bewerkt door een moderator:
Gebruik eerst eens codetags en inspringpunten.
 
Dank je voor je hulp ik ben geen expert
Kan je ajb iets meer aanwijzingen geven want dit is te incryptisch voor me
Dank je
 
Wat is incryptisch? Verder is het een onleesbaar geheel. En als je even gezocht had op de titel van jouw eigen vraag dan was je er waarschijnlijk ook wel achter gekomen wat codetags en inspringpunten zijn.

Zonder voorbeeldbestand denk ik niet dat iemand jouw vraag gaat beantwoorden.
 
Ik heb er bij een bakje koffie wel even tijd voor, maar je bent al lang genoeg lid dat je dat zou moeten weten.
Dit is de manier waarop je code hoort te plaatsen om het leesbaar te houden. Tevens met de inspringpunten op de juiste posities.
Code: 
Sub Menu()
    ' --------------------------------------------------------------------------------
    ' | Initialisatie.
    ' --------------------------------------------------------------------------------
    
    ' Application.DisplayAlerts = False ' Meldingen (fouten bijv) uit.
    
    curpath = ThisWorkbook.Path                     'Huidige directory.
    Dim MenuFilename1 As String                     'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim MenuFilename2 As String                     'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim MenuFilename3 As String                     'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim MenuFilenameFull1 As String                 'Idem met path.
    Dim MenuFilenameFull2 As String                 'Idem met path.
    Dim MenuFilenameFull3 As String                 'Idem met path.
    
    Sheets("Menu").Activate
    MenuFilename1 = Range("MenuFilename1").Value    ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    MenuFilename2 = Range("MenuFilename2").Value    ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    MenuFilename3 = Range("MenuFilename3").Value    ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    MenuFilenameFull1 = curpath & "" & MenuFilename1
    MenuFilenameFull2 = curpath & "" & MenuFilename2
    MenuFilenameFull3 = curpath & "" & MenuFilename3
    
    Application.Run ("'" & MenuFilenameFull1 & "'!test1")
    Application.Run ("'" & MenuFilenameFull2 & "'!test2")
    Application.Run ("'" & MenuFilenameFull3 & "'!Results_Data_dp_Vis_Zeef")
    
    Workbooks(MenuFilename1).Close
    Workbooks(MenuFilename2).Close
    Workbooks(MenuFilename3).Close
    
    ' Application.Run ("'" & workbookname & "'!macroname")
    ' Application.Run ("'Analytics macro S17.xlsm'!getdata")
    ' Workbooks(Filename).Close
    
    ' Workbooks.Open (FilenameFull) ' Open resultaten bestand.
    ' Application.Run "Results_Data_dp_Vis_Zeef"
    ' Workbooks(Filename).Close

End Sub

Sub Results_Data_dp_vis_zeef()
    ' --------------------------------------------------------------------------------
    ' | Initialisatie.
    ' --------------------------------------------------------------------------------
    
    Application.Calculation = xlAutomatic   ' Automatisch rekenen aan.
    Application.DisplayAlerts = False       ' Meldingen (fouten bijv) uit.
    
    Dim i, j, x, y As Long
    Dim Array1() As Variant
    
    curpath = ThisWorkbook.Path             'Huidige directory.
    Dim Filename As String                  'Bestandsnaamaam van bestand waar de resultateh naar moeten worden weggeschreven.
    Dim FilenameFull As String              'Idem met path.
    
    ' Definieren van je matrix.
    ReDim Array1(14, 16)                    '14 = aantal dagen, 2x8=16 aantal rijen, aantal te onthouden resultaten.
    
    ' --------------------------------------------------------------------------------
    ' | Initieren data resultaten bestand.
    ' --------------------------------------------------------------------------------
    
    Sheets("Calc").Activate
    Filename = Range("Filename").Value      ' Lees de bestandsnaam in waarin de resulaten moeten worden weggeschreven.
    FilenameFull = curpath & "" & Filename
    
    y = Range("start").Row
    x = Range("start").Column
    
    For i = 1 To 14 'y
        For j = 1 To 16 'x
            Array1(i, j) = Cells(y + i - 1, x + j - 1)
        Next j
    Next i
    
    Workbooks.Open (FilenameFull)           ' Open resultaten bestand.
    y = Range("start_dp_vis_zeef").Row
    x = Range("start_dp_vis_zeef").Column
    
    Sheets("data").Activate
    For i = 1 To 14
        For j = 1 To 16
            Cells(i - 1 + y, x + j - 1) = Array1(i, j)
        Next j
    Next i
    
    ActiveWorkbook.SaveAs Filename:=(FilenameFull) 'Bestand met resultaat opslaan.
    Workbooks(Filename).Close

End Sub
Wat de code moet doen begrijp ik niet helemaal en zal zonder voorbeeldbestand(en) inderdaad lastig te beantwoorden zijn, ook omdat je nogal wat named ranges gebruikt.

Wat ik wel zie is dat je hier:
FilenameFull = curpath & "" & Filename een \ teken mist, tenzij deze in Range("Filename").Value staat, maar daar ga ik niet vanuit.

Het moet dus dit zijn:
FilenameFull = curpath & "\" & Filename

Dat doe je op meerdere plekken, maar of dat de oorzaak van je probleem is kan ik zo niet zeggen.
 
Laatst bewerkt:
Je hebt gelijk, nu zie ik het dat het veel duidelijker is om inspring e.d. te gebruiken.
Ik zal mijn leven beteren. Sorry.
Ja ik ben al even lid maar helemaal afhankelijk welke soort studenten stage lopen en met vragen bij me komen gebruik ik visual basic.
Een expert ben ik dus zeker niet.
Ik heb een voorbeeld meegestuurd in een zip.
Als ik het bestandje "start.xlsm" draai gaat het helemaal goed en worden in dit geval willekeurige gegevens in een ander "data.xlsx" bestandje weggeschreven.
Nu wil de student dit een aantal malen achter elkaar doen oftewel verscheidene macro's achter elkaar draaien.
Voor het gemak gebruiken we "! Menu.xlsm" waarin twee test macro's in draaien (om het niet te moeilijk te maken) en dus de macro opvraagt in "start.xlsm" met de macro 'uitvoer'.
En daar gaat het fout. Ik heb de foutmeldingen in "! Menu.xlsm" gezet.

Hier gaat het fout

Sheets("Calc").Activate
Filename = Range("Filename").Value ' Lees de bestandsnaam in waarin de resultaten moeten worden weggeschreven.


is dit duidelijk zo of moet ik het duidelijker verwoorden?
Ik waardeer heel erg jullie help.

dank daarvoor.
groet
 

Bijlagen

  • test.zip
    87,4 KB · Weergaven: 20
Gebruik deze macro; dat is voldoende.

Code: 
Sub M_snb()
   With GetObject(ThisWorkbook.Path & "\" & Blad5.Cells(1, 6))
       .Sheets(1).Cells(1).Resize(14, 16) = Blad5.Cells(8, 1).CurrentRegion.Offset(1).Value
       .Windows(1).Visible = True
       .Close -1
   End With
End Sub

Verwijder alle benoemde gebieden.
Gebruik altijd rij 1 en kolom A voor gegevens.

PS. een bestand met een uitroepteken in de bestandsnaam lijkt me niet erg handig.
 

Bijlagen

  • __export snb.xlsb
    18,6 KB · Weergaven: 26
Laatst bewerkt:
Tjonge, dank hiervoor.
Dit werkt inderdaad.
Ik moet gaan uitzoeken hoe ik wat meer flexibiliteit kan inbouwen om dit te combineren met andere bronnen en celnamen in excel.
 
Oplossing

Naast jullie oplossing ben ik erachter wat er bij mij mis ging.
Eigenlijk best logisch.

Als ik het bestand met de macro eerst open en dan draai en daarna sluit gaat het gewoon goed.

Workbooks.Open (MenuFilenameFull1)
Application.Run ("'" & MenuFilenameFull1 & "'!Copy_Results_Data")
Workbooks(MenuFilename1).Close

Nogmaals dank voor de oplossing.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan