Macro voor opslaan

[Albatros]

Hoi,

Ik ben op zoek naar een macro, om blad1, van een excelbestand op te slaan.
De bestandsnaam moet dan overeenkomen met de tekst zoals ik deze heb staan in "H2"

Als dit bestand reeds bestaat, wil ik de vraag krijgen, of ik het bestaande bestand moet overschrijven.

Wie ziet de uitdaging?

Albatros

 

[Wigi]

Albatros,

Deze code slaat het bestand op wanneer het gesloten wordt. Je kan kiezen om te overschrijven of niet.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ActiveWorkbook.SaveAs Filename:=Worksheets("Blad1").Range("H2").Value
End Sub

 

[LucB]

Albatros,

Deze code geeft een waarschuwing als het bestand al bestaat en geeft gelegenheid
een andere Naam in te typen.
De kopie wordt in dezelfde Map opgeslagen als de oorspronkelijke.
Succes.


Sub Opslaan_Als()
Dim new_filepath As String
Dim new_filename As String

new_filepath = ThisWorkbook.Path
new_filename = new_filepath & Application.PathSeparator & Sheets(1).Range("H2") & ".xls"
Do
If Chk(new_filename) Then
new_filename = InputBox("Dit Bestand bestaat al." & Chr(10) & "Typ een andere naam in.", "TYPE FILENAME", Left(new_filename, Len(new_filename) - 4) & "2")
If new_filename <> "" Then
new_filename = new_filename & ".xls"
Else
MsgBox "Je hebt geannuleerd.", 48, "Annuleren"
Exit Sub
End If
End If
Loop While Chk(new_filename)
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & new_filename
End Sub

Function Chk(myFile As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Chk = fso.FileExists(myFile)
Set fso = Nothing
End Function

 

[Maik]

Wat ik zoek lijkt heel erg op bovenstaande, ik kom er echter nog niet uit, misschien kan iemand me helpen?

Ik gebruik de volgende macro om bestanden op te slaan:

Sub bewaren()
'
' bewaren Macro
' De macro is opgenomen op 12-01-2006 door mairoz.
'
Dim CelMetNaam As String
Application.DisplayAlerts = False
CelMetNaam = ActiveSheet.Range("EI5").Value
ThisWorkbook.SaveAs Filename:="S:\BEDRIJFSBUREAU\" & CelMetNaam
Application.DisplayAlerts = True
MsgBox ("O P G E S L A G E N als " & Range("EI5").Value)
End Sub


Wat ik zou willen is dat als het bestand reeds bestaat er een vraag komt om bestand te overschrijven ja of nee.
Bij nee de melding NIET opgeslagen
Bij ja de melding: MsgBox ("O P G E S L A G E N als " & Range("EI5").Value)

Maik

 

[Albatros]

Hoi Luc,

Je macro geeft een foutmelding.
Zie bijlage.

Zelf had ik deze nog ergens staan, maar ik wil er geen datum voor, en als het bestand al bestaat, moet er gevraagd worden voor overschrijving.

Sub SavePage()
Dim sText As String

ActiveSheet.Copy
sText = Format$(Now, "dd_mm_yyyy ") & ActiveSheet.Range("I2").Value & ".xls"
ActiveWorkbook.SaveAs sText

End Sub

Albatros

 

[Wigi]

Werkt dit?

Sub SavePage()
Dim sText   As String

ActiveSheet.Copy
sText = ActiveSheet.Range("I2").Value & ".xls"
ActiveWorkbook.SaveAs Filename:=sText

End Sub

 

[LucB]

Albatros,

Beide macro's aangepast.
Werken beide bij mij.

 

[Albatros]

Hoi,

Voor wat mij betreft ben ik geholpen met de makro "SavePage".

De andere makro geeft nog steeds een foutmelding bij:

ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & new_filename

Eenieder bedankt:thumb: , en prettige Paasdagen!

Albatros

 

[LucB]

Albatros,

Per abuis is de vorige keer niet de juiste verbetering meegestuurd.
Wxcuses daarvoor.

Deze werkt echt.

 

[Albatros]

Hoi Luc,

Dit werkt perfect.:thumb:
Bedankt en tot de volgende keer!

Albatros

 

[jdo]

Hallo

Is het mogenlijk om in de macro opslaan_als de keuze te laten om wel te overschrijven?

Alvast bedankt