• 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 aanpassen met macro

Status
Niet open voor verdere reacties.

scherpbierje

Gebruiker
Lid geworden
18 apr 2012
Berichten
9
Hallo,
is het mogelijk om een macro aan te passen met een macro?
Ik heb een macro in Personal.XLSB staan met daarin een "vaste" variabele.
Nu zoek ik een mogelijkheid om die variabele met behulp van een invoerveld op verzoek aan te passen, maar niet elke keer, alleen als ik dat wil.
De macro start telkens een nieuw leeg workbook zodat ik die variabele niet in het workbook kan opslaan.

de code zie je hier onder
Code:
Sub Giro_Afschrijvingen()
' Giro_Afschrijvingen Macro
'
Dim wb As Workbook
Set wb = Workbooks.Add


doorgaan = True

Dim eerste_rij As Integer
Dim doel As Variant

eerste_rij = 1

Application.Run ("bepaal_naam")


'eerst naar de juiste directory gaan
    ChDir ("H:\Scherpbierje\Documents\ADMINISTRATIE\Banken\Giro ING Afschrijvingen")

'de eerste keer werkblad leegmaken en evt aanwezige querytabellen weghalen
    Cells.Select
        If ActiveSheet.QueryTables.Count > 0 Then
            Selection.QueryTable.Delete
        End If
    Selection.ClearContents
    Selection.NumberFormat = "General"
    Range("A1").Select

Do While doorgaan = True

    doel = Range("A65536").End(xlUp).Row + 1
    doel = "$A$" & doel
    'Querytabel invullen
        With ActiveSheet.QueryTables.Add(Connection:= _
            bron _
            , Destination:=Range(doel))
            .Name = naam
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = eerste_rij
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(5, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        
    response = MsgBox("Nog een bestand ophalen? ", vbYesNo + vbDefaultButton2)
        If response = vbYes Then
            'MsgBox ("doorgaan")
            eerste_rij = 2
            doorgaan = True
opnieuw:
            Application.Run ("bepaal_naam")
            If doorgaan = False Then
               Exit Do
            End If
            If rekening_nr <> Cells(3, 3).Value Then
                MsgBox ("verkeerde rekening, probeer opnieuw")
                GoTo opnieuw    'Application.Run ("bepaal_naam")
                If doorgaan = False Then
                    Exit Do
                End If
                
            End If
            
            For Each einddatum In [A:A]
                If Right(einddatum, 7) = Right(naam, 7) Then
                     For Each begindatum In [A:A]
                         If Right(begindatum, 7) = Mid(naam, 23, 7) Then
                             Exit For
                         End If
                     Next begindatum
                     MsgBox ("bestand al ingelezen, probeer opnieuw")
                      GoTo opnieuw  ' Application.Run ("bepaal_naam")
                     Exit For
                End If
            Next einddatum
            
                       
    
        Else
            'MsgBox ("stoppen")
            doorgaan = False
        End If
Loop

' Absolute bedragen uit querytabel omzetten naar gewone bedragen
    For i = 3 To ActiveCell.SpecialCells(xlLastCell).Row
        If Cells(i, 6).Value = "Af" And Cells(i, 7).Value > 0 Then
            Cells(i, 7).Value = Cells(i, 7) * -1
        End If
    Next i
    
    Application.Run ("opmaak_aanpassen")
    Application.Run ("Bepaal_maandsaldo")
    test = Application.Run("opslaan", naam)
End Sub

ik wil dus ChDir ("H:\Scherpbierje\Documents\ADMINISTRATIE\Banken\Giro ING Afschrijvingen") in de macro kunnen aanpassen met een invoerscherm maar dus zodanig dat hij bij de volgende keer opstarten van de macro de aangepaste directory gebruikt zonder dat ik die opnieuw moet ingeven.

Iemand een idee?
 

Bijlagen

ChDir is een totaal overbodige opdracht dus kan je beter je code er beter op inrichten.
 
hoezo chdir overbodig?

edmoor:
"ChDir is een totaal overbodige opdracht dus kan je beter je code er beter op inrichten."
wat bedoel je hiermee Edmoor?
Als ik een in te lezen bestand ophaal (dat doe ik met de macro "Bepaal naam" met een Application.GetOpenFilename("Text Files (*.csv), *.csv") wordt de directory waar ik dat bestand ophaal de currentdirectory.
Ik wil mijn bestand niet in die directory opslaan maar in de dir die als variabele "H:\Scherpbierje\Documents\ADMINISTRATIE\Banken\Giro ING Afschrijvingen" is ingesteld.

Met de opmerking "dus kan je beter je code er beter op inrichten." kom ik helaas niet veel verder.
Maar toch bedankt voor de reactie.
 
ChDir werkt sowieso niet als je van een andere schijf komt dan opgegeven in ChDir.
Dan moet je ook nog ChDrive gebruiken.
Je kan Application.FileDialog(msoFileDialogFilePicker) gebruiken en dan de InitialFileName opgeven.
Deze mag ook een pad bevatten.
Het wijzigen van een macro vanuit een macro kan wel maar is veel meer en precies werk en vereist toegang voor de gebruiker tot het VBA project.

Je kan dan beter dat pad opslaan in een bestandje en deze weer inlezen wanneer nodig.
Zet dat bestandje in de map waar de macro ook staat, dan kan je er altijd bij.

Als ik wat meer tijd had nu zou ik je er bij helpen, maar helaas niet nu.
Maar er zijn er hier meer die dat wel kunnen.
 
Laatst bewerkt:
OK Bedankt Edmoor!

Bedankt Edmoor!
Nu weet ik wat meer en ga verder proberen het te realiseren.
fijn weekeinde!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan