Macro voor bestandsnaam = celwaarde

[tomas123]

Mijn vraag
Ik heb 225 excel bestanden, met elk dezelfde layout. Ik wil de naam van het bestand in een vaste cel krijgen. Al deze bestanden staan in een map. Ik zou graag hiervoor de macro willen maken/krijgen, zodat dit bij alle 225 bestanden gebeurt.

Relevante software en hardware die ik gebruik
Excel VBA

Wat ik al gevonden of geprobeerd heb
Gegoogled in het Engels, Nederlands, echter de meeste macro's zijn precies andersom, dat de celwaarde naar de bestandsnaam / tabbladnaam gaat.

Heb zelf weinig ervaring met het maken van macro's, wel bestaande gebruiken die op verschillende fora staan.

[mhoogendam]

https://www.stuartsplace....renaming-with-powershell/

[tomas123]

mhoogendam schreef op donderdag 3 oktober 2019 @ 16:12:
https://www.stuartsplace....renaming-with-powershell/

Dit is niet mijn vraag.

[Raznov]

Combineer zoiets
https://www.thespreadshee...l-files-in-a-given-folder
Met zoiets:

code:

Range("A1").Select
        ActiveCell.FormulaR1C1 = "=SUBSTITUTE(LEFT(CELL(""filename""),FIND(""]"",CELL(""filename""))-1),""["","""")"

        Range("A1").Select
        Calculate

En dan pas je A1 aan naar de juiste cell en zorg je er voor dat alles in 1 map staat.

[ Voor 23% gewijzigd door Raznov op 03-10-2019 16:30 ]

[TheFes]

tomas123 schreef op donderdag 3 oktober 2019 @ 16:22:
[...]

Dit is niet mijn vraag.

Blijkbaar is je vraag niet helemaal duidelijk dan. Wat wil je dan wel? Simpelweg de huidige bestandsnaam in een cel krijgen?

Daar heb je geen VBA voor nodig, kan gewoon met een formule:
https://support.office.co...99-4912-a14c-240c2eb51e0b

[mhoogendam]

Je kan ook een simpele formule gebruiken, met een calculate actie word deze geupdate.

code:

=CELL("filename")

[tomas123]

TheFes schreef op donderdag 3 oktober 2019 @ 16:28:
[...]

Simpelweg de huidige bestandsnaam in een cel krijgen?

Daar heb je geen VBA voor nodig, kan gewoon met een formule:
https://support.office.co...99-4912-a14c-240c2eb51e0b

Ja, dit, alleen dan voor 225 bestanden. Volgensmij staat in mijn vraag duidelijk dat de bestandsnaam in een vaste cel moet en niet dat ik bestandsnamen in batch moet veranderen

[mhoogendam]

Wat wil je nou dat die macro/script voor je gaat doen?

[RaZ]

Je kan die 225 bestanden allemaal voorzien van een VBA marco dat de filename in een vast cel wordt gezet.

Maarja, dan kan je net zo goed alles met de hand doen, ipv een macro copy'pasten en uitvoeren en daarna opslaan.

Wat jij wilt is een excelbestand met een macro die een map uitleest, automatisch opent, de filename in een vaste cel zetten, en opslaan.

Dat is wel te doen, maar dan zal iemand dat hier voor je moeten uittikken, aangezien je er weinig verstand van hebt.

[Raznov]

Het leukste is natuurlijk om het zelf te maken.

spoiler:

Sub CellName()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents

Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(LEFT(CELL(""filename""),FIND(""]"",CELL(""filename""))-1),""["","""")"

Range("A1").Select
Calculate

'Save and Close Workbook
wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
DoEvents

'Get next file name
myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

En dan ben ik al heel lui, want een groot deel van de code heb ik gebruikt van die eerste link die ik gaf, tweede deel maak je even zelf en klaar.

[ Voor 3% gewijzigd door Raznov op 03-10-2019 16:41 ]

[tomas123]

RaZ schreef op donderdag 3 oktober 2019 @ 16:38:
Je kan die 225 bestanden allemaal voorzien van een VBA marco dat de filename in een vast cel wordt gezet.

Maarja, dan kan je net zo goed alles met de hand doen, ipv een macro copy'pasten en uitvoeren en daarna opslaan.

Wat jij wilt is een excelbestand met een macro die een map uitleest, automatisch opent, de filename in een vaste cel zetten, en opslaan.

Dat is wel te doen, maar dan zal iemand dat hier voor je moeten uittikken, aangezien je er weinig verstand van hebt.

Dit zoek ik inderdaad.

[Raznov]

tomas123 schreef op donderdag 3 oktober 2019 @ 16:44:
[...]

Dit zoek ik inderdaad.

En, is het je nog gelukt?

[dix-neuf]

@tomas123, Om het voor jou zo eenvoudig mogelijk te maken onderstaande oplossing (waarbij ik bewust wat dingen heb weggelaten die er eigenlijk wel in zouden moeten). Ik ben er vanuitgegaan dat alle 225 Excelbestanden de extensie .xlsx hebben.

Open een nieuw Excelbestand, toets ALT-F11, kies daar boveaan in het menu: "Invoegen" - "Module", en plaats in de module deze macro:

code:

Sub macro1()
Dim myFile As String
myFile = Dir(ThisWorkbook.Path & "\*.xlsx")
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
On Error Resume Next
Do While Right(myFile, 4) = "xlsx"
Workbooks.Open myFile
With Workbooks(myFile)
.Sheets(1).Range("A1").Value = myFile
.Close savechanges:=True
End With
myFile = Dir()
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Sluit het vba-venster door op het kruisje rechtsboven te klikken, je komt dan terug in het eerste werkblad. Kies in het menu: "Bestand" - "Opslaan als", geef het bestand een naam en sla het op als .xlsm-bestand (=Excelbestand met macro's) in de map waarin de 225 Excelbestanden staan waarin je in A1 de bestandsnaam wil zien verschijnen.

Zorg dat boven het lint de tab "Ontwikkelaars" zichtbaar is. Als die dat niet is, kies dan in het menu: "Bestand-Opties- Lint aanpassen", vink aan de rechterkant aan: "Ontwikkelaars" en klik op "Ok".

Klik boven het lint op "Ontwikkelaars" en daarna in de groep "Programmacode" op "Macro's". Selecteer in het verschijnende venster "macro1" en klik op "Uitvoeren". Heb dan even geduld.