• 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.

Als SaveAs al bestaat dan, With Application.Dialogs(xlDialogSaveAs)

  • Onderwerp starter Onderwerp starter HWV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.213
Meerdere If then als het al bestaat dan volgende If

Voor het opslaan van onze bestellijsten gebruik ik de volgende code:

Code: 
Sub Savetest2()
HoofdletterBeginnen
  With Workbooks.Add
     With .Sheets(1)
       ThisWorkbook.Sheets("Bestellijst1").Range("A:X").Copy .[A1]
       ThisWorkbook.Sheets("Bestellijst1").Range("1:500").Copy .[A1]
         For Each sh In ActiveWorkbook.Worksheets
         Columns("Y:AN").Delete
        With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$18"
        ActiveWindow.DisplayGridlines = False
    End With
   ' ActiveSheet.PageSetup.PrintArea = "$A$1:$AB$146"
    With ActiveSheet.PageSetup
        .CenterFooter = _
        "&8PPP 1/1/1/1/1/1/ B.V  -  1/1/1/1/1 10 - 12  -  1111 AA -  /1/1/1/1/1/1/  -  WWW.PPP.NL " & Chr(10) & "&7Al onze leveringen vinden plaats volgens de leveringsvoorwaarden van de" & Chr(10) & " PPP gedeponeerd bij de KvK te Amsterdam en Den Haag"
        .RightFooter = "Blad &P van &N"
        .TopMargin = Application.CentimetersToPoints(1)
        .BottomMargin = Application.CentimetersToPoints(2.2)
        .LeftMargin = Application.CentimetersToPoints(0.5)
        .RightMargin = .LeftMargin
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
    End With
  Next
.Parent.SaveAs "P:\Bestellijsten\Bestellijsten\" & .[E7] & " " & .[F9] & " " & .[E6] & Format(Date, " dd-mm-yyyy") & ".xls"
    End With
    .Close
  End With
End Sub
Wat ik nu in de code erbij wil zetten is als de naam bestaat dat hij dan vraag waar hij het moet opslaan ( vooraf ingesteld op P:\Bestellijsten\Bestellijsten\) en met welke naam. Dit kan volgens mij met de volgende code:
Code: 
With Application.Dialogs(xlDialogSaveAs)
.Show
End With

Enkel hier heb ik niet de plaats in kunnen definiëren van P:\Bestellijsten\Bestellijsten\
Ik krijg het helaas niet voor elkaar om dit in mijn code te integreren, dus zodra ze willen opslaan en de naam bestaat al dat dan pas de dialos venster in beeld komt.

Heeft iemand een idee.

Groet HWV
 
Laatst bewerkt:
Code: 
Sub SaveTextFile()

    Dim sFname As String
    Dim lFnum As Long
    Dim rRow As Range
    Dim rCell As Range
    Dim sOutput As String
    
    sFname = Application.GetSaveAsFilename(InitialFileName:="c:\test\" & .[E7] & " " & .[F9] & " " & .[E6] & Format(Date, " dd-mm-yyyy") & ".xls")
        
    If sFname <> “False” Then
        lFnum = FreeFile
        
        Open sFname For Output As lFnum
        
        For Each rRow In Sheet1.UsedRange.Rows
            For Each rCell In rRow.Cells
                sOutput = sOutput & rCell.Text & vbTab
            Next rCell
            
            Print #lFnum, sOutput
            
            sOutput = “”
        Next rRow
        
        Close lFnum
    End If
    
        
End Sub

Ik heb de code toegepast maar krijg een foutmelding op:
Code: 
& .[E7] &

Toen heb ik een aanpassing gedaan
Code: 
Sub SaveTextFile()

    Dim sFname As String
    Dim lFnum As Long
    Dim rRow As Range
    Dim rCell As Range
    Dim sOutput As String
    
    sFname = Application.GetSaveAsFilename(InitialFileName:="c:\test\test.xls")
        
    If sFname <> “False” Then
        lFnum = FreeFile
        
        Open sFname For Output As lFnum
        
        For Each rRow In Sheet1.UsedRange.Rows
            For Each rCell In rRow.Cells
                sOutput = sOutput & rCell.Text & vbTab
            Next rCell
            
            Print #lFnum, sOutput
            
            sOutput = “”
        Next rRow
        
        Close lFnum
    End If
    
        
End Sub
Nu vraag hij het bestand op te slaan met de opgegeven naam test.
ik sla deze op en krijg dan een foutmelding op regel :
Code: 
For Each rRow In Sheet1.UsedRange.Rows
Hoe krijg ik het werkend dat ik wel mijn orginele code met verwijzingen voor de naam mee kan nemen, maar dat al se naam al bestaat dat hij dan vraag waar hij deze moet plaatsen en welke naam.

Groet HYWV
 
De code die ik gaf, is bedoeld om een werkend voorbeeld te hebben van GetSaveAsFilename. De rest van die code moet je natuurlijk niet mee overnemen.

Testen of een bestand bestaat doe je met Dir. Je zet dat in een IF, en afhankelijk van het resultaat laat je de GetSaveAsFilename uitvoeren of niet.
 
Op de goede weg

Code: 
Sub Savetest3()
' Controleer of bestand bestaat
If Dir("C:/test/" & Range("E7") & " " & Range("f9") & " " & Range("E6") & ".xls") = Range("E7") & " " & Range("f9") & " " & Range("E6") & ".xls" Then
' als bestaat vragen waar op te slaan
With Application.Dialogs(xlDialogSaveAs)
.Show
End With
Else
'zo niet volgende code gebruiken

  With Workbooks.Add
     With .Sheets(1)
       ThisWorkbook.Sheets("Blad1").Range("A:X").Copy .[A1]
       ThisWorkbook.Sheets("Blad1").Range("1:500").Copy .[A1]
         For Each sh In ActiveWorkbook.Worksheets
         Columns("Y:AN").Delete
        With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$18"
        ActiveWindow.DisplayGridlines = False
    End With

    With ActiveSheet.PageSetup
        .CenterFooter = _
        "&8PPP 1/1/1/1/1/1/ B.V  -  1/1/1/1/1 10 - 12  -  1111 AA -  /1/1/1/1/1/1/  -  WWW.PPP.NL " & Chr(10) & "&7Al onze leveringen vinden plaats volgens de leveringsvoorwaarden van de" & Chr(10) & " PPP gedeponeerd bij de KvK te Amsterdam en Den Haag"
        .RightFooter = "Blad &P van &N"
        .TopMargin = Application.CentimetersToPoints(1)
        .BottomMargin = Application.CentimetersToPoints(2.2)
        .LeftMargin = Application.CentimetersToPoints(0.5)
        .RightMargin = .LeftMargin
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
    End With
  Next
.Parent.SaveAs "c:\test\" & .[E7] & " " & .[F9] & " " & .[E6] & ".xls"
    End With
    .Close
  End With
  End If
  End Sub

Ben al een end gekomen, heb wel wat aanpassingen moeten doen maar hier het resultaat.
Ik heb de datum uit de omschrijving moeten halen want dat kreeg ik niet voor elkaar.

Zodra het bestand bestaat dan krijg je een venster waar hij vraag waar hij het moet opslaan een welke naam.

Ik zou heel graag de datum nog in de omschrijving willen hebben, hoe kan ik dit voor elkaar krijgen

Is het ook mogelijk om in
Code: 
With Application.Dialogs(xlDialogSaveAs)
.Show
End With

Aan te geven dat hij in de map c:\test\ het venster moet openen
Groet HWV
 
Laatst bewerkt:
- Gebruik een variabele voor de bestandsnaam, dan moet je dezelfde code niet te vaak herhalen.
- Een With ... End With constructie met maar 1 regel tussen is nogal onnozel.
- Waar is de GetSaveAsFilename eigenlijk?
 
Onduidelijk

Beste,

Bedankt voor uw reactie op mijn vraag.

Ik ben deze code`s tegen gekomen op het web en zodoende ook zo verwerkt.
Ben nog druk bezig het boek excel VBA 2007 step by step van microsoft te lezen dus weet helaas niet alles maar wil wel graag bij leren.

- Gebruik een variabele voor de bestandsnaam, dan moet je dezelfde code niet te vaak herhalen.
Klik om te vergroten...

Het is voor onze bestellijsten dus elke keer wordt het een andere naam, ik wilde deze functie inbouwen zodat ze er bewust van worden dat als ze een bestellijst opslaan dat deze al bestaat en dat ze er bijvoorbeeld een 1,2,3 achter kunnen zetten voor versie 1,2,3

- Een With ... End With constructie met maar 1 regel tussen is nogal onnozel.
Klik om te vergroten...

Ik kan dus de volgende code omzetten:
Code: 
With Application.Dialogs(xlDialogSaveAs)
.Show
End With
naar

?

- Waar is de GetSaveAsFilename eigenlijk?
Klik om te vergroten...

Ik heb daar voor in de plaats genomen:

Code: 
With Application.Dialogs(xlDialogSaveAs)
.Show
End With

Wat de code GetSaveAsFilename inhoud weet ik niet de help functie geef het volgende maar hoe ik dit moet toepassen zou ik niet weten
Code: 
fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:="Text Files (*.txt), *.txt")
If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName
End If

Groet HWV
 
HWV zei:
Ik kan dus de volgende code omzetten:
Code: 
With Application.Dialogs(xlDialogSaveAs)
.Show
End With

naar ?
Klik om te vergroten...

Code: 
Application.Dialogs(xlDialogSaveAs).Show

Wat de code GetSaveAsFilename inhoud weet ik niet de help functie geef het volgende maar hoe ik dit moet toepassen zou ik niet weten
Code: 
fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:="Text Files (*.txt), *.txt")
If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName
End If
Klik om te vergroten...

Zet dit stukje dan eens in een aparte macro om te testen. Enkel dat, niets anders. Voer de macro uit, kies een bestand en de MsgBox moet dat dan tonen. Je kan dit dan toch zonder al te veel aanpassingen in de huidige code opnemen?
 
uitleg

Deze code doet niets anders dan je vertellen dat je het bestand moet opslaan met de vooraf opgegeven excentie . Bij het opslaan met mijn code sla hij het toch altijd al op met de excentie .xls

Groet HWV
 
Je moet de txt wel vervangen door xls, en ook de Msgbox moet een SaveAs statement worden. Anders zal er effectief niet veel opgeslagen worden.
 
Code: 
Sub test4()
fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:=".xls (*.xls), *.xls")
If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName
End If
End Sub

Dit controleer de excentie en geef een melding voor als het niet overeen komt met elkaar

Maar ik kan de link niet leggen met mijn vraag stelling in mijn topic 5

http://www.helpmij.nl/forum/showpost.php?p=2884665&postcount=5


Groet HWV
 
Al weer verder gekomen

Beste,

Ik heb de code uitgewerkt zoals hieronder.
Maar graag zou ik nog een if then else er in willen hebben, zodat als versie 1 al bestaat hij dan opslaat met versie 2.
Tevens is het mogelijk om in de MsgBbox de bestandsnaam te laten zien

Code: 
Sub Savetest4()

If Dir("C:/test/" & Range("E7") & " " & Range("f9") & " " & Range("E6") & Format(Date, " dd-mm-yyyy") & " " & ".xls") = Range("E7") & " " & Range("f9") & " " & Range("E6") & Format(Date, " dd-mm-yyyy") & " " & ".xls" Then


MsgBox ("Administrator " & vbCrLf & vbCrLf & "Het bestand is al aanwezig onder deze naam." & vbCrLf & "Het wordt opgeslagen onder een versie nummer bv:" & vbCrLf & vbCrLf & "Naam plaats Debnr Datum Versie (1) tussen de haakjes het versie nummer")

With Workbooks.Add
     With .Sheets(1)
       ThisWorkbook.Sheets("Blad1").Range("A:X").Copy .[A1]
       ThisWorkbook.Sheets("Blad1").Range("1:500").Copy .[A1]
         For Each sh In ActiveWorkbook.Worksheets
  Next
.Parent.SaveAs "c:\test\" & .[E7] & " " & .[F9] & " " & .[E6] & Format(Date, " dd-mm-yyyy") & " " & "versie 1" & ".xls"
    End With
    .Close
  End With
  
  Else

  With Workbooks.Add
     With .Sheets(1)
       ThisWorkbook.Sheets("Blad1").Range("A:X").Copy .[A1]
       ThisWorkbook.Sheets("Blad1").Range("1:500").Copy .[A1]
         For Each sh In ActiveWorkbook.Worksheets
  Next
.Parent.SaveAs "c:\test\" & .[E7] & " " & .[F9] & " " & .[E6] & Format(Date, " dd-mm-yyyy") & " " & ".xls"
    End With
    .Close
  End With
   End If
   End Sub

Groet HWV
 
Vraag stelling aangepast

Beste,

Is het mogelijk meerder "if then" te defineren

Wat ik wil bereiken is het volgende bij het opslaan

Als bv
"test.xls"
bestaat dat hij dan het bestand opslaat als
"test versie 1.xls"
Maar als deze ook bestaat dat deze dan opgeslagen wordt als
"test versie 2.xls"

Natuurlijk zou het mooi zijn om dit te doen voor meerder versie`s maar dat kan ik dan misschien zelf wel er bij brouwen.

En dit dan in een if then funcie, meerde dingen gerobeer samen met de helpfunctie maar kom er niet uit.

Groet HWV
 
Gebruik de ingebouwde faciliteiten van Excel (tenzij eruit gesloopt bij 2007):

Code: 
Sub tst()
  With Application.FileSearch
    .LookIn = "E:\OF"
    .Filename = "bestand(*.xls"
    ActiveWorkbook.SaveAs .LookIn & "\" & Replace(.Filename, "*", .Execute & ")")
  End With
End Sub
 
Aangepast, maar doet niet wat ik zou willen

Code: 
Sub tst()
  With Application.FileSearch
    .LookIn = "H:\Test"
    .Filename = " versie(*.xls"
    ActiveWorkbook.SaveAs .LookIn & "\" & Range("E7") & " " & Range("F9") & " " & Range("E6") & Format(Date, " dd-mm-yyyy") & Replace(.Filename, "*", .Execute & ")")
  End With
End Sub

Beste,

Ik uw code aangepast naar mijn wensen, kom het volgende tegen.
In E7 staat de Naam
In F9 staat Plaatsnaam
In E6 staat Debnummer

Het wordt gebruikt in een bestellijst, deze wordt opgslagen:

"Henk Barendrecht 1236 14-09-2009 versie(0)"

Zodra ik de bestellijst sluit, en een nieuwe bestellijst maakt vooor een andere klant dan gaat hij verder met de versie nummering. Terwijl dit een nieuwe bestellijst is en dat hij deze niet moet doortellen.
Nu maakt hij ervan:

"Kees Rotterdam 1236 14-09-2009 versie(1)"

Het is juiste de bedoeling dat dit per bestellijst opgelagen wordt met de opgegeven veldnamen, maar zodra het bestand al bestatat dat hij dan de versie nummering gaat hanteren.

In de hoop dat u mij verder kunt helpen.

groet HWV
 

Bijlagen

Kijk naar de code, kijk naar wat je wil en denk na.
Pas vervolgens de code aan, zodat die precies doet wat jij wil.
 
Erg moeilijk om het te snappen

Beste,

Ik heb gekeken en een aantal dingen geprobeerd ( zeg maar klungelen ) maar niet gelukt
Code: 
& Replace(.Filename, "*", .Execute & ")")
Gekeken of het hier aan lig en dingen verwijderd om te kijken wat er gebeurd.

Moet ik denken aan de code die ik al heb gebruikt Topic 1
If Dir om te kijken of deze la bestaat en dan met de if then functie gaan werken

Groet HWV
 
Kijk naar .filename

als
.filename="Henk Barendrecht 1236 14-09-2009 versie(*.xls"

worden alle versies met deze naam gezocht.
mutatis mutandis:

.filename="Kees Rotterdam 1236 14-09-2009 versie(*.xls"
 
Laatst bewerkt:
Nog niet

Beste,

Bedankt voor uw sugestie, maar nog onduidelijk voor me.
Ben gaan zoeken in de help naar .Filenaam
Niet kunnen vinden wat het zou moeten zijn, domweg om dat ik die materie nog niet onder de knie heb.
Code: 
.Filename = " versie(*.xls"
Geef de naam aan het bestand.

Code: 
& Replace(.Filename, "*", .Execute & ")")
Koppeld deze naam aan het bestand

Helaas ik kom er niet uit,

Groet HWV

Later pas de aanvulling gelezen op de topic hierboven
mutatis mutandis betekent letterlijk "nadat veranderd is wat veranderd moet worden". Dikwijls betekent dit dat men een tekst niet helemaal herhaalt, maar aan de lezer/toehoorder zegt: verander het op die punten waar het veranderd moet worden.
Klik om te vergroten...

En ook met deze aanvulling wil het niet lukken
 
Laatst bewerkt:
Beste SNB,

Het hou me bezig en ik kom er niet uit.
Volgens mij moet het
Code: 
.filename="& Range("E7") & " " & Range("F9") & " " & Range("E6") & Format(Date, " dd-mm-yyyy") &(*.xls"

Maar dan krijg ik gelijk de foutmelding op E7

Ik hoop dat u mij hierin kunt ondersteunen om dit werkend te krijgen..

Groet HWV
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan