Originele map opslaan met als enige wijziging het opgehoogde nummer.

[jodelo]

Hallo forumleden:

Mijn probleem is het volgende, voor mijn werk heb ik een inkoopaanvraagformulier gedigitaliseerd.
Medewerkers kunnen hiermee een aanvraag indienen om bepaalde diensten of producten aan te schaffen.
Het formulier wordt vervolgens na het invullen met de knop OPSLAAN in een bepaalde map met een bepaalde bestandsnaam opgeslagen.
Deze map is nu even C:\temp om uit te testen maar wordt later een netwerkmap.
Dit werkt allemaal.
Probleem is dat het originele bestand dat toegankelijk is voor bepaalde personen via het netwerk moet worden opgeslagen (nadat de ingevulde gegevens door een macro zijn gewist)
maar met behoud van het automatisch opgehoogde aanvraagnummer in cel E2 zodat de volgende die het bestand opent een leeg bestand krijgt met een nieuw nummer.

Op dit moment moet ik het bestand na leegmaken iedere keer opslaan als het origineel.
Andere medewerkers zullen dit geheid vergeten waardoor er dus dubbele aanvraagnummers ontstaan.

Wie kan mij hier mee verder helpen.
PS dit is het originele bestand waar ik enkel de namen van medewerkers van heb gewijzigd.

met vriendelijke groet Jo

 

[TALES]

Sub Leegmaken()
'
' Leegmaken Macro
'

'
    Sheets("AANVRAAG").Range("E2").Value = Sheets("AANVRAAG").Range("E2").Value + 1
    Range("J5:K7,D18:K18,D19:K19,A22:K36").Select
    Range("A22").Activate
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-6
    Range("J5:K5").Select
End Sub

dan het bestand opslaan

 

[jodelo]

TALES:

Ik heb het geprobeerd en zo te zien werkt het. Ik had hier helemaal niet aan gedacht maar als ik de code bekijk zie ik wat ik gemist heb.
Bedankt voor de snelle en juiste reactie.

Ik denk dat ik iets te snel heb gereageerd. Het blijkt dat ik nog steeds het origineel bestand moet opslaan nadat het gewijzigd is.
Het probleem ligt hem er in dat andere medewerkers waarschijnlijk zullen kiezen voor niet opslaan waardoor het aanvraagnummer gelijk blijft aan het vorige.

Jo

 

[TALES]

ActiveWorkbook.Save

saved het bestanden bestand
Mogelijk dat dit het gewenste resultaat is

Sub Leegmaken()
'
' Leegmaken Macro
'

'
    Sheets("AANVRAAG").Range("E2").Value = Sheets("AANVRAAG").Range("E2").Value + 1
    Range("J5:K7,D18:K18,D19:K19,A22:K36").Select
    Range("A22").Activate
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-6
    Range("J5:K5").Select
ActiveWorkbook.Save
End Sub

 

[jodelo]

TALES:

Dat is de oplossing.
Het origineel wordt nu bewaard met het opgehoogde nummer, wat ook de bedoeling was.

Bedankt voor je hulp, ben toch nog niet ver genoeg met VBA om sommige connecties te leggen.

m.vr.gr. Jo

 

[HSV]

Dat kan anders.

Sub Leegmaken()
'
' Leegmaken Macro
'


  With Sheets("AANVRAAG")
   .Range("E2") = .Range("E2").Value + 1
   .Range("J5:K7,D18:K18,D19:K19,A22:K36").ClearContents
  End With
 ThisWorkbook.Save
End Sub

 

[jodelo]

Hallo Harry:

Dat werkt natuurlijk ook, code is compacter en voor mij iets makkelijker te begrijpen.
Ook jij bedankt voor het meedenken.

gr. Jo

 

[edmoor]

Ik denk dat dit voor de Opslaan knop voldoende is:

Sub opslaan()
    pad = Sheets(1).Range("B55").Value & "\"
    bestand = pad & Range("D18") & "_" & Format(Date, "dd-mm-yyyy") & "_" & Range("E2") & ".xlsm"
    
    If MsgBox("Bestand wordt opgeslagen als:" & Chr(10) & bestand & Chr(10) & "Is dit correct ?", vbYesNo) = vbYes Then
        ActiveWorkbook.SaveCopyAs bestand
        Range("J5:K7,D18:K18,D19:K19,A22:K36").ClearContents
        Range("E2") = Range("E2") + 1
        ActiveWorkbook.Save
    End If
End Sub

 

[jodelo]

Hallo Edmoor:

Jou code werkt tot het opnieuw openen van het origineel. Hierin staat dan het oude aanvraagnummer, dus niet het met 1 opgehoogde.

 

[jodelo]

Hallo Harry:

Dat werkt natuurlijk ook, code is compacter en voor mij iets makkelijker te begrijpen.
Ook jij bedankt voor het meedenken.

gr. Jo

Het blijkt toch dat het origineel bestand geen opgehoogd nummer heeft maar het nummer waarmee hij is opgeslagen naar de andere map.
Jammer ik zou niet weten hoe dit op te lossen zonder het leeggemaakte bestand weer op te slaan.

 

[snb]

Mij lijkt het opslaan van het bestand met een nieuwe naam voldoende.
Daarna wordt het bestadn gesloten.
Het oorspronkelijke bestand blijft dan ongewijzigd.
Dus hoeft er niets leeggemaakt te worden.

Dit is alles

Sub M_snb()
   y = CreateObject("scripting.filesystemobject").getfolder("G:\OF").Files.Count
   ActiveWorkbook.SaveAs "G:\OF\aanvraag_" & Format(y + 1, "0000"), 52
   ActiveWorkbook.Close 0
End Sub

of als je heel slim bent zet je dit in het workbook_open event:

Sub M_snb()
   y = CreateObject("scripting.filesystemobject").getfolder("G:\OF").Files.Count
   ActiveWorkbook.SaveAs "G:\OF\aanvraag_" & Format(y + 1, "0000"), 52
End Sub

En leer svp het gebruik van samengevoegde cellen af.

 

[jodelo]

Mij lijkt het opslaan van het bestand met een nieuwe naam voldoende.
Daarna wordt het bestadn gesloten.
Het oorspronkelijke bestand blijft dan ongewijzigd.
Dus hoeft er niets leeggemaakt te worden.

Hallo SNB
Als het bestand via de macro is opgeslagen zou dan het origineel met een opgehoogd nummer weer geopend moeten worden.
Dit gebeurd echter niet, het nummer blijft hetzelfde als ik het bestand bij afsluiten niet opsla.
Misschien doe ik iets fout of snap ik het niet helemaal !!

 

[edmoor]

Hallo Edmoor:

Jou code werkt tot het opnieuw openen van het origineel. Hierin staat dan het oude aanvraagnummer, dus niet het met 1 opgehoogde.

Zie de laatste aanpassing in die code.

 

[snb]

Je snapt het niet.

 

[edmoor]

Werkt bij mij prima.
Na het sluiten van het originele bestand en weer openen staat er keurig het laatst gebruikte volgnummer.

 

[jodelo]

Werkt bij mij prima.
Na het sluiten van het originele bestand en weer openen staat er keurig het laatst gebruikte volgnummer.

Klopt Edmoor, ik heb inmiddels meerdere kopieën van het bestand en had jou code in de verkeerde geplakt.
Hij werkt inderdaad.
Bedankt voor het geduld, gelukkig dat jullie er zijn om ons het juiste pad te wijzen.

 

[jodelo]

Mij lijkt het opslaan van het bestand met een nieuwe naam voldoende.
Daarna wordt het bestadn gesloten.
Het oorspronkelijke bestand blijft dan ongewijzigd.
Dus hoeft er niets leeggemaakt te worden.

Dit is alles

Sub M_snb()
   y = CreateObject("scripting.filesystemobject").getfolder("G:\OF").Files.Count
   ActiveWorkbook.SaveAs "G:\OF\aanvraag_" & Format(y + 1, "0000"), 52
   ActiveWorkbook.Close 0
End Sub

of als je heel slim bent zet je dit in het workbook_open event:

Sub M_snb()
   y = CreateObject("scripting.filesystemobject").getfolder("G:\OF").Files.Count
   ActiveWorkbook.SaveAs "G:\OF\aanvraag_" & Format(y + 1, "0000"), 52
End Sub

En leer svp het gebruik van samengevoegde cellen af.

Ja SNB ik denk dat het voor jullie gesneden koek is maar dat geld zeker niet voor mij.
Daarom gebruik ik misschien vaak code die jullie niet kunnen waarderen.
Maar ik heb het eerst zelf geprobeerd en dat vindt ik toch al heel wat.
Bedankt voor de hulp en ik twijfel nu welke code te gebruiken, die van jou of die van Edmoor.

 

[edmoor]

Er leiden meerdere wegen naar Rome.
De keuze is aan jou

Daarnaast was je zelf inderdaad aardig op weg

 

[snb]

Daar zou ik geen enkele twijfel over hebben....:d