macro code vereenvoudigen

[gerenmarly]

deze code zit onder een button
als deze gedrukt wordt voert hij hem uit
tijd wordt geregistreed van opslaan
cel C5 gecontroleerd of er iets in staat, zo niet dan vraagt hij om die in te vullen
als hij dan is ingevuld en weer op de button wordt gedrukt schrijf hij hem weg op aangegeven plek
bij dit opslaan knippert het beeld door de bewerkingen
kan dit voorkomen worden
en kan de code ook eenvoudiger

Sub Opslaan()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
     Range("F2").Select
     ActiveCell.FormulaR1C1 = Time
      Range("J16").Select
    With Sheets("werkorder 1")
        
        If .Range("C5").Value = vbNullString Then
            MsgBox ("          Voor opslaan eerst Machine nummer invullen.")
            Application.GoTo .Range("C5")
            GoTo haserror
        End If
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs "C:\" & "Rekenstaat" & .Range("C5").Value & ".xlsm"
        Application.DisplayAlerts = True
        
    End With
    
haserror:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Groetjes Ger

 

[HSV]

Bv. door geen cellen te selecteren.
Ongetest:

Sub Opslaan()
    Application.ScreenUpdating = False
     Range("F2") = Time
    With Sheets("werkorder 1")
        
        If .Range("C5").Value = vbNullString Then
            MsgBox ("          Voor opslaan eerst Machine nummer invullen.")
            Application.GoTo .Range("C5")
            GoTo haserror
        End If
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs "C:\" & "Rekenstaat" & .Range("C5").Value & ".xlsm"
    End With
    
haserror:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[snb]

Sub Opslaan()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
    
   With Sheets("werkorder 1")
     .Range("F2") = Time
     If .Range("C5").Value = "" Then
       Application.GoTo .Range("C5")
       MsgBox ("          Voor opslaan eerst Machine nummer invullen.")
     else
       ThisWorkbook.SaveAs "C:\Rekenstaat" & .Range("C5").Value & ".xlsm"
     End If
   End With
End Sub

 

[gerenmarly]

hoi snb en HSV
dit is hem geworden

Sub Opslaan()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
    
     Range("F2").Select
     ActiveCell.FormulaR1C1 = Time
     Range("J16").Select
     With Sheets("werkorder 1")
     
     If .Range("C5").Value = "" Then
       Application.GoTo .Range("C5")
       MsgBox ("          Voor opslaan eerst Machine nummer invullen.")
     Else
      Application.DisplayAlerts = False
       ThisWorkbook.SaveAs "C:\Rekenstaat" & .Range("C5").Value & ".xlsm"
     End If
   End With
End Sub

bij deze slaat hij de tijd op en geen geknipper van het werkblad

bedankt Ger

 

[HSV]

Toe maar, je vraagt advies, maar slaat het gewoon domweg in de wind.
Select en selection zijn overbodig, en daar komt het knipperen ook vandaan.

Application.displayalerts staat in de code al op false, die hoeft niet nog een keer toch?, en op het einde ook nog even terug op "true".
Beetje jammer dat je de code van @snb niet veranderd hebt als de cel F6 niet in blad "werkorder 1" hoort.
Daar moet ook "displayalerts" nog wel even op true gzet worden aan het eind.

 

[gerenmarly]

Hoi HSV
ik sla jullie adviezen niet domweg in de wind
ik heb ze toegepast, maar kreeg niet het gewenste resultaat

Application.displayalerts staat in de code al op false, die hoeft niet nog een keer toch?

ja deze moet wel anders vraagt hij (bestand bestaat al overschrijven?)

 als de cel F6 niet in blad "werkorder 1" hoort.

deze staat niet in de code?

Groetjes Ger

 

[HSV]

Mijn excuus het moest F2 zijn.

In je code staat bovenaan de displayalerts al op false die hoef je voor het opslaan niet nog een keer op false te zetten.
Het staat er nl. twee keer in, en onderaan staat het niet weer op true.
Ook heb je niet goed gekeken hoe je 'select en selection' moet vermijden, dus enige opmerking is dan toch wel op z'n plaats.

 

[edmoor]

Tevens selecteer je J16 waar je vervolgens niets mee doet. Daarom hadden HSV en snb deze eruit gelaten.

 

[gerenmarly]

Hoi
Ik heb die tweede displayalerts eruit gehaald
Maar krijg dan de vraag "bestand bestaat al overschrijven"
En dit is wat ik eigelijk niet wil
En J16 selecteer ik omdat dit weer de eerste cel is die ingevuld wordt
Wat F2 betreft deze wordt pas ingevuld als het bestand wordt opgeslagen ,en als hij weer opnieuw overschreven wordt dan staat hier de tijd van opslaan
Deze wordt dus steeds ververst
Ger

 

[edmoor]

Hoi
Ik heb die tweede displayalerts eruit gehaald
Maar krijg dan de vraag "bestand bestaat al overschrijven"

Waarom haal je die er dan uit???

 

[gerenmarly]

Heb die er weer in gezet
Maar HSV gaaf aan dat dit niet twee keer erin hoeft "staat al op false"
Vandaar
Ger

 

[edmoor]

Als je dan toch de vraag krijgt staat ie daar niet op False. Je kunt beter even je code plaatsen zoals deze nu is.

 

[gerenmarly]

de code zoals hij nu is

Sub Opslaan()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
    
     Range("F2").Select
     ActiveCell.FormulaR1C1 = Time
     Range("J16").Select
     With Sheets("werkorder 1")
     
     If .Range("C5").Value = "" Then
       Application.GoTo .Range("C5")
       MsgBox ("          Voor opslaan eerst Machine nummer invullen.")
     Else
      Application.DisplayAlerts = False
       ThisWorkbook.SaveAs "C:\Rekenstaat" & .Range("C5").Value & ".xlsm"
     End If
   End With
End Sub

 

[edmoor]

Ik zou het zo doen:

Sub Opslaan()
    With Sheets("werkorder 1")
        If .Range("C5").Value = "" Then
      	    Application.GoTo .Range("C5")
            MsgBox ("          Voor opslaan eerst Machine nummer invullen.")
        Else
            Application.DisplayAlerts = False
            Range("F2") = Time
            ThisWorkbook.SaveAs "C:\Rekenstaat" & .Range("C5").Value & ".xlsm", FileFormat:=52
            Application.GoTo Range("J16")
            Application.DisplayAlerts = True
        End If
    End With
End Sub

Die ScreenUpdating hoef je in dit geval niks mee te doen, dus die hoeft er niet in. Verder heb je de opmerking van Geen Select gebruiken niet in acht genomen.

Gebruik voor de leesbaarheid ook juiste inspringpunten.

 

[edmoor]

Ik heb nog een aanpassing gedaan, mocht je hem al gekopieerd hebben.

 

[gerenmarly]

heb de laatste gebruikt in het bestand
krijg nu weer de vraag bestand bestaat al ,overschrijven
en geen tijd wordt getoond

 

[edmoor]

Dan vraag ik me af wat je doet want de sub zoals ik die heb geplaatst KAN dat niet. Dan kan je beter even je bestand plaatsen.

Edit:
Ik heb nog een kleine wijziging gedaan. (, FileFormat:=52)
Welicht dat je daar tegenaan liep.

 

[gerenmarly]

ga het zo even testen

 

[gerenmarly]

Heb hem getest

Sub Opslaan()
    With Sheets("werkorder 1")
        If .Range("C5").Value = "" Then
            Application.GoTo .Range("C5")
            MsgBox ("          Voor opslaan eerst Machine nummer invullen.")
        Else
            Range("F2").Select
            Range("F2") = Time
            ActiveCell.FormulaR1C1 = Time
            Application.DisplayAlerts = False
            ThisWorkbook.SaveAs "C:\Rekenstaat" & .Range("C5").Value & ".xlsm", FileFormat:=52
            Application.GoTo Range("J16")
            Application.DisplayAlerts = True
        End If
    End With
End Sub

heb wel de code

            Range("F2").Select
            Range("F2") = Time
            ActiveCell.FormulaR1C1 = Time

erbij gezet, anders komt de tijd niet in F2
Hij werkt nu zoals ik in gedachte had

Bedankt Edmoor snb en HSV voor jullie inbreng

groetjes Ger

 

[edmoor]

Dat is weer niet zoals het moet. Maar goed, als het voor jou werkt is dat ok natuurlijk.