bestand bestaat al

[wim1985]

Ik heb hier een deel van een macro. Hij slaat hier een sheet op. Dit mag slechts 1 keer onder de zelfde naam. Dus als de macro een 2e keer gedaan wordt en de bestandsnaam bestaat dan al moet hij hem niet overschrijven maar dit overslaan en de rest van de macro uitvoeren. Is dit mogelijk?

Gr Wim

 

[enijhuis]

Hoi Wim,

Ja, dat is mogelijk.
Kun je de macro hier plaatsen?
Wat moet er gebeuren in geval van een bestaand bestand/werkblad?

 

[wim1985]

Dit is een stukje uit de code. De bestandsnaam staat dan als variabele in K1. (dit is de datum van die dag) Zou de macro dan nog een keer gebruikt worden dan zou hij hem overschrijven (als de display allert uit staan) Dit mag niet. Als hij ziet dat het bestand al bestaat moet hij hij niet opslaan en verder gaan met de overige code.

Gr Wim

 Application.ScreenUpdating = False
    
    With ActiveSheet
        sBestandsnaam = .Range("K1").Value
        .Copy
    End With
    
    With ActiveWorkbook
        .SaveAs "\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam
        .Close
    End With

 

[Ginger]

Wim1985, Dit kan je doen met de Dir functie

If Len(Dir("\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam)) = 0 then  'bestand bestaat nog niet...
'rest van je code
End If

Maar waarom niet opslaan onder een nieuwe naam???

Groet, Leo

 

[wim1985]

Ik heb het nu zo tussen de code geplakt en werkt niet. hij overschrijft gewoon het bestand.
Staat het nu op een verkeerde plek?

gr Wim

Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    With ActiveSheet
        sBestandsnaam = .Range("K1").Value
        .Copy
    End With
  If Len(Dir("\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam)) = 0 Then

    End If  
    
    With ActiveWorkbook
.SaveAs "\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam
        .Close

  
       
    End With
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

 

[Ginger]

Wim1985, Probeer je code te begrijpen, dan zie je wat er fout gaat... Het mooiste om code 'te leren lezen' is door met de F8 toets in je VB-Editor door je code te lopen. Regel voor regel wordt afgewerkt en kan je zien wat een regel doet. (zelf het probleem tackelen is beter dan het voorgekauwd krijgen!)

Als je er niet uit komt, geef je maar een gil.

Groet, Leo

 

[Wigi]

2 tips, naast de F8 en het 'proberen begrijpen' uit de post van Leo.

• Laat je code inspringen (manueel met tabs), dan heb je ten minste structuur in de code zitten en zie je beter wat je aan het doen bent
• een IF-END IF met niks ertussen is niks waard, want IF dient juist om op iets te testen, en afhankelijk van de uitkomst deze of gene actie te doen

 

[wim1985]

Wim1985, Probeer je code te begrijpen, dan zie je wat er fout gaat... Het mooiste om code 'te leren lezen' is door met de F8 toets in je VB-Editor door je code te lopen. Regel voor regel wordt afgewerkt en kan je zien wat een regel doet. (zelf het probleem tackelen is beter dan het voorgekauwd krijgen!)

Als je er niet uit komt, geef je maar een gil.

Groet, Leo

Met die F8 functie kun je inderdaad wel volgen wat hij in grote lijnen doet. Echter bij deze code kom ik er niet uit. Besteed er echt wel veel tijd aan en wil er liefst ook wel zelf uitkomen en dat lukt met 90% van de dingen ook wel. Maar dit zijn dan weer van die dingen die ik niet goed doorgrond. Zou je me uit de droom kunnen helpen.

Alvast bedankt

gr Wim

Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    
    With ActiveSheet
         sBestandsnaam = .Range("K1").Value
         .Copy
    End With
    
    With ActiveWorkbook
    
    If Len(Dir("\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam)) = 0 Then
    
        .SaveAs "\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam = True
    Else
        .SaveAs "\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam = False
    End If
        .Close
    End With
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True

 

[Ginger]

Wim1985, tuurlijk wil ik je helpen...

Wat denk je van zoiets? (niet getest ivm verder ontbrekende code)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    [COLOR="Blue"]sBestandsnaam = ActiveSheet.Range("K1").Value[/COLOR]
    
    If Len(Dir("\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam)) = 0 Then
        [COLOR="blue"]ActiveSheet.Copy[/COLOR]
        With ActiveWorkbook
            .SaveAs "\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam
            .Close
        End With
    [COLOR="blue"]End If[/COLOR]
    
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

Groet, Leo

 

[wim1985]

Beste Ginger,

Hij slaat wel op onder de juiste naam, maar dat bestand bestond al en heeft het nu overschreven. Hij ziet dus blijkbaar niet dat het bestand al bestond of iets dergelijks?
Ik heb bovenaan in de macro ook nog 12 een regel invoegen, dit werkt erg traag is daar wat beters voor?

Gr Wim

Sub doorvoeren()

        Sheets("registratieblad").Select
        Cells.Select
        ActiveSheet.Unprotect
        Rows("2:2").Select
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Sheets("Formule").Select
        Range("A2:D13").Select
        Selection.Copy
        Sheets("registratieblad").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A2:G17").Select
        Selection.Font.Bold = False
        Sheets("registratieblad").Select
        Columns("A:G").Select
        Range("A:G").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range _
            ("B2"), Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
            xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
            DataOption3:=xlSortNormal
        Sheets("registratieblad").Select
        Cells.Select
        Sheets("Invoerblad2").Select
        Range("H11:I11").Select
        Selection.ClearContents
        Range("H11:I11").Select
        Range("A1").Select
        Sheets("registratieblad").Select
        ActiveSheet.PageSetup.PrintArea = "$A$1:$F$80"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 70
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    
        Range("J1").Select
        Selection.Copy
        Range("K1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    
    
     sBestandsnaam = ActiveSheet.Range("K1").Value
    
    If Len(Dir("\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam)) = 0 Then
        ActiveSheet.Copy
        With ActiveWorkbook
            .SaveAs "\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam
            .Close
        End With
    End If
    
    
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Sheets("registratieblad").Select
        Cells.Select
        ActiveSheet.Unprotect
        Sheets("controleblad").Select
        Cells.Select
        ActiveSheet.Unprotect
        Sheets("controleblad").Select
        Range("A1:H1").Select
        Selection.Delete Shift:=xlUp
        Sheets("registratieblad").Select
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Cut
        Sheets("controleblad").Select
        Range("A1").Select
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown
        Sheets("controleblad").Select
        Range("A1:G1").Select
        Selection.Copy
        Sheets("registratieblad").Select
        Range("A1:G1").Select
        ActiveSheet.Paste
        Sheets("controleblad").Select
        Range("A1:G1").Select
        Selection.Delete Shift:=xlUp
        Sheets("controleblad").Select
        Cells.Select
        Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
            , Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
            xlSortNormal
        Sheets("registratieblad").Select
        Range("A1:G1").Select
        Selection.Copy
        Sheets("controleblad").Select
        Range("A1:G1").Select
        Selection.Insert Shift:=xlDown
        Sheets("Formule").Select
        Range("F1").Select
        Selection.Copy
        Sheets("controleblad").Select
        Range("H2").Select
        ActiveSheet.Paste
        Range("H2").Select
        Selection.Copy
        Range("H3:H1000").Select
        ActiveSheet.Paste
        Sheets("Formule").Select
        Range("I1").Select
        Selection.Copy
        Sheets("controleblad").Select
        Range("H1").Select
        ActiveSheet.Paste
        Sheets("registratieblad").Select
        Cells.Select
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Sheets("controleblad").Select
        Cells.Select
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Sheets("Invoerblad2").Select
        Range("H11").Select
        ActiveWorkbook.Save
End Sub

 

[Ginger]

Wim1985, Het mooie van code opnemen met de macrorecorders is dat je geen VBA hoeft te kennen om iets (simpel) te automatiseren. Het nadeel van code opnemen met de macrorecorders is dat het over het algemeen een gedrocht van een code is...

Maar om te beginnen met je 2e vraag

Ik heb bovenaan in de macro ook nog 12 een regel invoegen, dit werkt erg traag is daar wat beters voor?

Dit ene regeltje vervangt die 12 van jou

Rows("2:14").Insert Shift:=xlDown

Probeer zelf ook 'ns zo aan de slag te gaan met al die 'selects' die in de code staan (eventueel in een nieuwe sub zodat je werkende het gewoon blijft doen).

Voor wat betreft je probleem met opslaan. Wat is de extensie van je eerder opgeslagen bestand? Is dat .xls? Zo ja, dan zal je dat óók moeten toevoegen in je test.

If Len(Dir("\\Dirkjan\shareddocs\urenregistratiesysteem\kopie urenbon\" & sBestandsnaam [COLOR="Blue"]& ".xls"[/COLOR])) = 0 Then

Probeer dit maar 's uit en dan horen we 't wel weer.

Groet, Leo

 

[wim1985]

hoi Leo,

Werkt beide perfect nu. Ik had inderdaad ook eerder als eens een probleem gehad met de .xls toevoeging. Deze macro is een van de oudste en moet wat betreft de .select en het samenvoegen van acties op 1 regel nog door mij aangepakt worden. Hij zal dan ook wel een heel stuk sneller worden. Bij andere macro's heb ik dat al gedaan en werkt veel beter dan en sneller. Elke regel kost toch tijd. Erg bedankt voor je hulp.
Ik durf het bijna niet te vragen..... maar ik heb nog een mega probleem daar ik dringend om een oplossing verlegen zit en al avonden zonder succes mee bezig ben. Ik heb hier de link even gezet. Zou je daar wat mee kunnen?

http://www.helpmij.nl/forum/showthread.php?t=397539

Gr Wim

ps ik zet deze op opgelost