• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro's inkorten

Status
Niet open voor verdere reacties.
stefano

stefano

Gebruiker
Lid geworden
22 mei 2004
Berichten
865
Gezien ik een werkblad heb met ongeveer 30 verschillende macro's dacht ik er aan één en ander te (proberen) vereenvoudigen. Zo heb ik onderstaande macro die ik wat wou inkorten.


VAN:

Code: 
Sub Grondstoffen_18()
    Dim bestand1 As String      ' ruwe data uit SAP
    Dim bestand2 As String      ' bestand met formules
    Dim bestand3 As String      ' wegschrijven als
    Dim pad As String           ' lokale pad op PC/laptop
    
    bestand1 = "18_01_1.XLS"
    bestand2 = "18_01_2.XLS"
    bestand3 = "18 - Grondstoffen.xls"
    pad = "C:\data\sap\"
    
    ' indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(bestand3)
    If Err.Number = 0 Then
        Wb.Close
    End If
    ' einde afsluiten
    
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:=pad & bestand1, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1)), TrailingMinusNumbers _
        :=True
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("G:IV").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.000"
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:=pad & bestand1, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

    Application.Run "RIJENSAMENVOEGEN"

    Workbooks.Open Filename:=pad & bestand2
    Workbooks(bestand2).Activate
    Cells.Copy
    Range("A1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Range("A1").Select
    Workbooks(bestand2).SaveAs pad & bestand3
    Workbooks(bestand1).Close False
    Application.DisplayAlerts = True

End Sub

NAAR:

Code: 
Sub Grondstoffen_18()
    Dim bestand1 As String      ' ruwe data uit SAP
    Dim bestand2 As String      ' bestand met formules
    Dim bestand3 As String      ' wegschrijven als
    Dim pad As String           ' lokale pad op PC/laptop
    
    bestand1 = "18_01_1.XLS"
    bestand2 = "18_01_2.XLS"
    bestand3 = "18 - Grondstoffen.xls"
    pad = "C:\data\sap\"
    
    ' indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(bestand3)
    If Err.Number = 0 Then
        Wb.Close
    End If
    ' einde afsluiten
    
Application.Run "HOOFDMACRO"

End Sub

Code: 
Sub Hoofdmacro()

    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:=pad & bestand1, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1)), TrailingMinusNumbers _
        :=True
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("G:IV").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.000"
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:=pad & bestand1, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

    Application.Run "RIJENSAMENVOEGEN"

    Workbooks.Open Filename:=pad & bestand2
    Workbooks(bestand2).Activate
    Cells.Copy
    Range("A1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Range("A1").Select
    Workbooks(bestand2).SaveAs pad & bestand3
    Workbooks(bestand1).Close False
    Application.DisplayAlerts = True

End sub

Alleen merk ik nu dat bij het verlaten van de eerste macro de variabelen (bestand1, bestand2, bestand3 en pad) niet meer gekend zijn in de tweede. Kan dit opgevangen worden?
 
Declareer de betreffende variabelen buite de sub, dus boven in de module waar die subs staan.
 
Dank alvast Ed.

Wanneer ik buiten de sub declareer dan gebeurt er niets bij het uitvoeren van de macro. Is er nog wat fout ?

Code: 
    Dim bestand1 As String      ' ruwe data uit SAP
    Dim bestand2 As String      ' bestand met formules
    Dim bestand3 As String      ' wegschrijven als
    Dim pad As String           ' lokale pad op PC/laptop
Sub Hoofdmacro()
    
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:=pad & bestand1, Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1)), TrailingMinusNumbers _
        :=True
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("G:IV").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.000"
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:=pad & bestand1, FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

    Application.Run "RIJENSAMENVOEGEN"

    Workbooks.Open Filename:=pad & bestand2
    Workbooks(bestand2).Activate
    Cells.Copy
    Range("A1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Range("A1").Select
    Workbooks(bestand2).SaveAs pad & bestand3
    Workbooks(bestand1).Close False
    Application.DisplayAlerts = True
    
End Sub
Sub P017_tarwe()
        
    bestand1 = "17_TA_1.xls"
    bestand2 = "17_TA_2.xls"
    bestand3 = "17_TA_3 - Tarwe Avelgem.xls"
    pad = "C:\data\sap\"
    
    ' indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(bestand3)
    If Err.Number = 0 Then
        Wb.Close
    End If
    ' einde afsluiten

Application.Run "Hoofdmacro"

End Sub
 
Die declaraties hebben niets met het uitvoeren van de macro zelf te maken en kan ik dus niets over zeggen.
Is Sub P017_tarwe() de eerste macro die wordt uitgevoerd en niks lijkt te doen?
Zet dan die On Error Resume Next eens uit.
 
Ed,

heb ik het dan goed voor dat onderstaand zou werken ?

dim bestand1 as string

sub macro1()
bestand1 = "100.xls'
.....
end sub()


sub macro2()
bestand1 = "200.xls"
....
end sub()
 
Inderdaad.
 
Ed,

Ik heb wat macro's aangepast en het werkt.

Wanneer ik echter macro's aanroep uit een andere module dan gaat het fout. Als je een macro aanroept die beschreven staat in een andere module dan worden de bestandsnamen van de laatst aangesproken macro gebruikt .... Enig idee hoe ik dat kan oplossen ?

dank alvast.

Stefano

Code: 
    Dim bestand1 As String      ' ruwe data
    Dim bestand2 As String      ' bestand met formules
    Dim bestand3 As String      ' wegschrijven als
    Dim pad As String           ' lokale pad op PC/laptop

Code: 
Sub P017_tarwe()

    bestand1 = "17_TA_1.xls"
    bestand2 = "17_TA_2.xls"
    bestand3 = "17_TA_3 - Tarwe Avelgem.xls"
    pad = "C:\data\sap\"
    
    Application.Run "Main"

End Sub

Code: 
Sub P017_grondstoffen()
    
    bestand1 = "17_GS_1.xls"
    bestand2 = "17_GS_2.xls"
    bestand3 = "17_GS_3 - Grondstoffen Avelgem.xls"
    pad = "C:\data\sap\"
    
    Application.Run "Main"

End Sub

Code: 
Sub P017_wit()
    
    bestand1 = "17_WIT_1.xls"
    bestand2 = "17_WIT_2.xls"
    bestand3 = "17_WIT_3 - Witte bloem Avelgem.xls"
    pad = "C:\data\sap\"
    
    Application.Run "Main"


End Sub
 
Dim geldt alleen voor de module waarin deze wordt gedaan.
Als je wilt dat die variabelen ook in andere modules beschikbaar zijn wijzig Dim dan in Public.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan