Variabele bestandsnaam

[weusty]

Ik heb een Raming-sjabloon gemaakt die prijzen en eenheden uit een ander bestand haalt.
Die code ziet er als volgt uit:

Sub Macro1()
    
  
    Application.ScreenUpdating = False
    
    DoEvents
    With UserForm1
                                    
    'gegevens verwijderen
    Sheets("Gegevens").Select
    Range("A2:D9999").Delete
        

    
    'bestand openen
    ChDir _
        "c:\enz\enz\enz\prijzen.xls"
    
    
    'regels selecteren, knippen & plakken
    'CODE
    Range("A8:A9999").Select
    Selection.Copy
  [B]  Windows("Raming maken.xls").Activate[/B]
    Sheets("Gegevens").Select
    Range("A2").Select
    ActiveSheet.Paste
    
    'regels selecteren, knippen & plakken
    'OMSCHRIJVING
    Windows("Prijzen.xls").Activate
    Range("B8:B9999").Select
    Application.CutCopyMode = False
    Selection.Copy
[B]    Windows("Raming.xls").Activate[/B]
    Range("B2").Select
    ActiveSheet.Paste
    
    'regels selecteren, knippen & plakken
    'EENHEID
    Windows("Prijzen.xls").Activate
    Range("C8:C9999").Select
    Application.CutCopyMode = False
    Selection.Copy
[B]    Windows("Raming.xls").Activate[/B]
    Range("D2").Select
    ActiveSheet.Paste
    
    'regels selecteren, knippen & plakken
    'PRIJS
    Windows("Prijzen.xls").Activate
    Range("E8:E9999").Select
    Application.CutCopyMode = False
    Selection.Copy
[B]    Windows("Raming.xls").Activate[/B]
    Range("C2").Select
    ActiveSheet.Paste
    
    'AFSLUITEN
    Application.CutCopyMode = False
    Range("G20").Select
    Windows("Prijzen.xls").Activate
    ActiveWindow.Close
    Sheets("Opbrengsten").Select
    Range("A14").Select

Unload UserForm2
End With
End Sub

deze code werkt goed.

Maar,,,,

Als de raming klaar is dan wordt het opgeslagen onder een andere naam. Daardoor zal deze code niet meer werken. Is er niet een code waarmee de bestandsnaam in de macro weer in de nieuwe bestandsnaam wordt gewijzigd?

Groet, Weust

 

[Wigi]

Als ik van jou was, zou ik eerst eens de code goed schrijven.

Al die Activate's, Select's en Application.CutCopyMode's zijn allemaal niet nodig.

Dus:

Workbooks("naamvanhetbronbestandmetxlserachter").Worksheets("naamvanhetbrontabblad").Range("tekopierenbereik").Copy Workbooks("naamvanhetdoelbestandmetxlserachter").Worksheets("naamvanhetdoeltabblad").Range("celnaarwaarjekopieert")

Bvb.

Workbooks("Prijzen.xls").Worksheets("Blad1").Range("A5:E20").Copy Workbooks("Raming.xls").Worksheets("Blad1").Range("B3")

Dit vervangt zo 1 blokje code van jou.

Wigi

 

[weusty]

Okay,
heb ik gedaan. Ziet er wat overzichtelijker uit zo:

Sub MacPRIJZEN()
      
    Application.ScreenUpdating = False
    
    DoEvents
    With UserForm1
'gegevens verwijderen
    Workbooks("Raming.xls").Worksheets("Gegevens").Range("A2:D9999").Delete
         
'bestand openen
    ChDir _
        "C:\map\map\map\map\Prijzen.xls"
    
'regels selecteren, knippen & plakken
'CODE
    Workbooks("Prijzen.xls").Worksheets("Blad1").Range("A8:A9999").Copy Workbooks("Raming.xls").Worksheets("Gegevens").Range("A2")
    
'regels selecteren, knippen & plakken
'OMSCHRIJVING
    Workbooks("Prijzen.xls").Worksheets("Blad1").Range("B8:B9999").Copy Workbooks("Raming.xls").Worksheets("Gegevens").Range("B2")
    
'regels selecteren, knippen & plakken
'EENHEID
    Workbooks("Prijzen.xls").Worksheets("Blad1").Range("C8:C9999").Copy Workbooks("Raming.xls").Worksheets("Gegevens").Range("D2")
    
'regels selecteren, knippen & plakken
'PRIJS
    Workbooks("Prijzen.xls").Worksheets("Blad1").Range("E8:E9999").Copy Workbooks("Raming.xls").Worksheets("Gegevens").Range("C2")
    
 'Sluiten
     Workbooks("Prijzen.xls").Close

End With
End Sub

wat moet ik nu doen dan?

Groet Weust

 

[Wigi]

Je kan met een variabele werken met daarin een bestand:

Dim wb As Workbook
Set wb = Workbooks("raming.xls")

en dan verder werken met wb in plaats van te verwijzen naar die Workbooks("raming.xls")

 

[snb]

Voor wat jij doet heeft Excel een ingebouwde funktie: databasequery.(menubalk/Data/externe gegevens/...)
Daarmee koppel je een bestand aan een ander bestand zodat het daarmee steeds geaktualiseerd/gesynchroniseerd kan worden.
Als de koppeling eenmaal gelegd is hoef je niets anders meer te doen dan die koppeling bij te laten werken (en dat kan ook automatisch bij het openen van het bestand).

De koppeling kun je leggen met deze macro, die je uitvoert in het werkboek raming.xls.
Vervang de groene delen door de pad-namen van jouw computer.

With ActiveSheet.QueryTables.Add("ODBC;DSN=Excel-bestanden;DBQ=prijzen.xls;DefaultDir=[COLOR="Green"]E:\OF[/COLOR];DriverId=790;MaxBufferSize=2048;PageTimeout=5;", Range("A8"))
   .CommandText = Array("SELECT `Blad1$`.[COLOR="green"]F1[/COLOR], `Blad1$`.[COLOR="green"]F2[/COLOR], `Blad1$`.[COLOR="green"]F3[/COLOR],  `Blad1$`.[COLOR="green"]F5[/COLOR]" & Chr(13) & "" & Chr(10) & "FROM `[COLOR="green"]E:\OF\[/COLOR]prijzen`.`Blad1$` `Blad1$`")
   .Refresh False
End With

F1, F2,F3,F5 staan voor de 'namen' van de kolommen die worden geimporteerd.
Als jij in het bestand prijzen in A1,B1,C1 etc. namen hebt staan moet je F1 vervangen door de tekst in A1, F2 door de tekst in B1, etc.

Daarna is jouw naamgevingsvraag ook opgelost.

 

[weusty]

Het gaat mij er om dat als iemand z'n raming klaar heeft en opslaat hij het waarschijnlijk niet meer "raming" zal noemen maar "08849 Raming dorpsstraat" of iets dergelijks.

Daarna zou mijn code dus niet meer werken.

Maar ga het wel eens proberen.

Groet

 

[Wigi]

Via GetOpenFileName kan je zelf in een schermpje het bestand kiezen.

Google er maar even op en je krijgt bijna kant-en-klare code.

 

[weusty]

Hey Wigi,

heb de volgende codes gevonden:

The macro below shows how you can let the user select a single filename:

Sub OpenOneFile()
Dim fn As Variant
    fn = Application.GetOpenFilename("Excel-files,*.xls", _
        1, "Select One File To Open", , False)
    If TypeName(fn) = "Boolean" Then Exit Sub 
    ' the user didn't select a file
    Debug.Print "Selected file: " & fn
    Workbooks.Open fn
End Sub

The macro below shows how you can let the user select multiple filenames:

Sub OpenMultipleFiles()
Dim fn As Variant, f As Integer
    fn = Application.GetOpenFilename("Excel-files,*.xls", _
        1, "Select One Or More Files To Open", , True)
    If TypeName(fn) = "Boolean" Then Exit Sub
    For f = 1 To UBound(fn)
        Debug.Print "Selected file #" & f & ": " & fn(f)
        Workbooks.Open fn(f)
        MsgBox ActiveWorkbook.Name, , "Active Workbook Name:"
        ActiveWorkbook.Close False 
        ' close the active workbook without saving any changes
    Next f
End Sub

The macro below shows how you can let the user select a filename for saving a workbook:

Sub SaveOneFile()
Dim fn As Variant
    fn = Application.GetSaveAsFilename("MyFileName.xls", _
        "Excel files,*.xls", 1, "Select your folder and filename")
    If TypeName(fn) = "Boolean" Then Exit Sub
    ActiveWorkbook.SaveAs fn
End Sub

van http://www.exceltip.com/show_tip/Fi...lenames_using_VBA_in_Microsoft_Excel/448.html

ik denk dat ik de onderste moet proberen.

Groet,
Weust

 

[weusty]

Dag Wigi,

ik heb het voor elkaar.

heb dit:

Dim wb As Workbook
Set wb = Workbook ("Raming.xls")
    Application.ScreenUpdating = False

veranderd in:

Dim wb As Workbook
Set wb = ThisWorkbook
    Application.ScreenUpdating = False

En dat werkt.
kan het bestand nu opslaan zoals ik wil. Heb dat openfile.......... niet gebruikt.

bedankt voor uw hulp.

Groet,
weust

 

[Wigi]

Als de code inderdaad zit in het bestand dat van naam verandert, dan kan dat ja. Ik dacht dat een ander bestand van naam veranderde.