Opslaan foutgevoelig

[Cobbe]

Zo dan?

 

[Hunuloeloe]

Wat is de code zodat ik hem opsla zoals de waarde in b1? want nu slaat die hem op als datum vandaag bij exporteren

Sub Kopie_Dagplanning_Expeditie()
  With Sheets("Dagplanning Expeditie")
         .Copy
         .Range("C8:L59").ClearContents
  End With
  With ActiveWorkbook
  Application.DisplayAlerts = False
    .SaveAs "I:\expeditie Holland\Dagplanning\Personeelsplanning\Dagproductie\Expeditie\Dagplanning " & Format(Date, "yyyy-mm-dd") & ".xlsx", 51
    .Close 0
    Application.DisplayAlerts = True
  End With
End Sub

Het gedeelte saveas moet kijken naar de waarde in b1

 

[Cobbe]

Vervang die Date door dit:

Sheets("Dagplanning Expeditie").Cells(1,2).value

 

[Hunuloeloe]

bijna hij leegt volgens mij als ik op exporteer druk eerst b1 voordat die hem opslaat. Welke gedeelte moet ik omwisselen?
Hij slaat hem nu alleen op als "dagplanning" ipv dagplanning + datum in b1

 

[Cobbe]

De clear weggehaald uit het Activate_event en in de Userform.Initialisatie geplaatst.

 

[Hunuloeloe]

Nou nu slaat die hem wel goed op etc maar ik krijg de userform niet meer in beeld nadat ik geëxporteerd heb.

 

[Cobbe]

Mag dat blad ook als PDF-file opgeslagen worden?

 

[Hunuloeloe]

nee want ze willen de gegevens nog kunnen gebruiken. zoals het totaal aantal pallets wat onderin wordt ingevuld willen ze nog kunnen mee kunnen rekenen m.b.v. vba.

 

[Cobbe]

Je zal een beetje geduld moeten hebben want ik kom er zo 123 niet uit (waarschijnlijk te veel aan mijn hoofd)
Ik zal er in de loop van de dag verder aan sleutelen.

 

[Hunuloeloe]

Cobbe geen probleem! ik ben al hartstikke blij dat er mensen zijn die me met dit probleem willen helpen
De waardering is groot :thumb:

 

[Cobbe]

Probeer deze eens:
Heb wel de opslagplaats aangepast naar C:\Testmap\

Dus die zou je even moeten aanmaken en dan je bestand daarin opslaan.

 

[Hunuloeloe]

 End If
Workbooks.Open Filename:="H:\Stage\Expeditie\Resource planning\Macro bestand\Dagproductie test\Resource planning(cobbe)-unprotected_3.xlsm"
Sheets("Dagplanning Expeditie").Range("C8:L59").ClearContents
End Sub

Wat doet dit gedeelte?

Ik heb wat dingen geprobeerd maar toen gaf het systeem aan dat ik onvoldoende geheugen had :0
Of ik doe wat fout of er zit een fout in het opslag proces maar ik weet niet wat

 

[Hunuloeloe]

Misschien moet ik even opnieuw uitleggen wat er moet gebeuren:

Als ik het blad dagplanning expeditie open wil ik een userform die me verplicht de datum in te vullen voor B1
Vervolgens ga ik de dagplanning gedeeltelijk invullen... Sla de resource planning op en open het bestand later weer waarna ik de dagplanning expeditie weer afmaak (datum moet dus blijven staan of de userform moet er weer om vragen)
Als ik de dagplanning ingevuld heb exporteer ik de dagplanning
Hiermee wordt de dagplanning opgeslagen op een andere locatie met de datum ingevuld in B1
Na deze actie wist dezelfde macro gelijk het cellenbereik waar ik de uren invul en cel B1


Ik hoop hiermee voldoende duidelijk te zijn geweest, zoniet vraag maar raak

 

[Cobbe]

Dan moet deze dat doen voor u:

 

[Hunuloeloe]

Deze doet het idd maar ik wil dat die niet het bestand dat ik exporteer gelijk weer open hoe doe ik dit

Sub Opslaan()
 Application.DisplayAlerts = False
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = "Dagplanning " & Format(Sheets("Dagplanning Expeditie").Range("B1").Value, "yyyy_mm_dd") & ".xlsx"
  If strFileName = False Then
    MsgBox "Het formulier is niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
      .SaveAs Filename:="H:\Stage\Expeditie\Resource planning\Macro bestand\Dagproductie test\" & strFileName
    End With
     MsgBox "Gelukt!  Opgeslagen als: " & strFileName
      Sheets("Dagplanning Expeditie").Range("C8:L59").ClearContents
  End If
End Sub

Tevens zie ik dat die het opnieuw geopende bestand wel de content leegmaakt maar niet in de resource planning (als die geëxporteerd is)? ik denk dat er iets door elkaar staat maar kan er niet uitkomen want :shocked:

 

[Cobbe]

Blijf maar testen.

Moet wel de SaveAs nog aanpassen(omwisselen)

 

[Hunuloeloe]

Wordt die dan zo?

Sub Opslaan()
 If Not IsDate(Sheets("Dagplanning Expeditie").Range("B1")) Then
   MsgBox " Geen geldige datum in B1 ingegeven!!"
     Exit Sub
 End If
 Application.DisplayAlerts = False
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = "Dagplanning " & Format(Sheets("Dagplanning Expeditie").Range("B1").Value, "yyyy_mm_dd") & ".xlsx"
  If strFileName = False Then
    MsgBox "Het formulier is niet opgeslagen! "
  Else
'    ActiveSheet.Copy
    With ActiveWorkbook
    [COLOR="#FF0000"].SaveAs Filename:="H:\Stage\Expeditie\Resource planning\Macro bestand\Dagproductie test\" & strFileName[/COLOR]
    End With
     MsgBox "Gelukt!  Opgeslagen als: " & strFileName
      Sheets("Dagplanning Expeditie").Range("C8:L59").ClearContents
  End If
ThisWorkbook.Close
End Sub

hij geeft namelijk foutcode aan op die manier :0

 

[Cobbe]

"H:\Stage\Expeditie\Resource planning\Macro bestand\Dagproductie test\"

Klopt dat wel want in mijn bestand stond drive I: aangegeven?

Kijk eens of je op de plaats van opslaan niet al bestanden hebt staan met dezelfde naam(haal die dan weg)

 

[Hunuloeloe]

Ja de I drive is de netwerkschijf maar ben momenteel op mijn eigen schijf (H) aan het testen

 

[Cobbe]

Gebruik deze eens:

Sub Opslaan()
 If Not IsDate(Sheets("Dagplanning Expeditie").Range("B1")) Then
   MsgBox " Geen geldige datum in B1 ingegeven!!"
     Exit Sub
 End If
 Application.DisplayAlerts = False
  Dim strFileName As Variant
  Dim strPath As String
  strFileName = "Dagplanning " & Format(Sheets("Dagplanning Expeditie").Range("B1").Value, "dd_mm_yyyy") & ".xlmx"
  If strFileName = False Then
    MsgBox "Het formulier is niet opgeslagen! "
  Else
 ThisWorkbook.Sheets("Dagplanning Expeditie").Copy
    With ActiveWorkbook
      .SaveAs Filename:="H:\expeditie Holland\Dagplanning\Personeelsplanning\Dagproductie\Expeditie\" & strFileName
    End With
     MsgBox "Gelukt!  Opgeslagen als: " & strFileName
       Sheets("Dagplanning Expeditie").Range("C8:L59").ClearContents
  End If
ThisWorkbook.Close
End Sub