Opslaan met de huidige bestandsnaam op een andere locatie via vba

[snitsel]

zet svp. je code hier.
Te oordelen aan de melding heb je meer dan eens dezelfde variabele gedeclareerd.

Dim c0 as string
--------

Dim c0 as string

-------
Set c0 as Range

etc.

Zie hier in de bijlage mij gebruikte vba code.
Dit is de hele Sub, maar het probleem begint bij het volgende tot de end sub:

'Opslaan van de Bestelling DEVOS in \\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen met het eerst volgende verhoogde nummer

Sheets("Devos").Select

Hopelijk kan je mij verder helpen

 

[snb]

Dit staat er meer dan eens in

   Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

verwijder zovaak, dat deze declaraties slechts 1 maal voorkomen.

Advies: zet alle regels die beginnen met dim boven in de procedure; dan zie je meteen welke regels dubbel voorkomen.

advies 2: haal alle regels met .select weg, die zijn overbodig en vertragend.

De onderstaande code doet waarschijnljk hetzelfde als de jouwe:

Sub PrintAllebestanden()
    With ActiveWorkbook
        .SaveAs "\\flsrv-01\Autocad\Collstrop\Offertes\2008\" & Range("B7").Text & "\" & Range("B7").Text & "_" & Range("A1")
        For Each sh In .Sheets
            With sh
                Select Case .Name
                Case "Uithaallijst"
                    .PageSetup.PrintArea = "$A$2:$F$43"
                    Select Case .Range("R7").Value
                    Case 0 'nederlands
                        .PrintOut 2
                        .Range("A6:A26").Font.ColorIndex = 2
                        .PageSetup.PrintArea = "$A$1:$F$43"
                        .PrintOut 1
                        .Range("A6:A26").Font.ColorIndex = 1
                    Case 1 'frans
                        Sheets("START").Range("R7").FormulaR1C1 = "0"
                        .PrintOut 2
                        Sheets("START").Range("R7").FormulaR1C1 = "1"
                        With .Range("A6:A26").Font
                            .ThemeColor = xlThemeColorDark1
                            .TintAndShade = 0
                        End With
                        .PageSetup.PrintArea = "$A$1:$F$43"
                        .PrintOut 1
                        With .Range("A6:A26").Font
                            .ColorIndex = xlAutomatic
                            .TintAndShade = 0
                        End With
                    End Select
                Case "Rail", "Beslag - In Beton", "Plaatsing - In Beton", "Beslag - Op Beton", "Plaatsing - Op Beton", "Montage beslag", "Devos", "MD10213", "MD10218", "MD10219", "MD10220", "MD10221", "MD10222", "Came", "Nestor"
                    .PrintOut 2
                Case "Productie fiche"
                    .PrintOut 1
                End Select
            End With
        Next
        
    Sheets(Choose(Sheets(1).Range("R5"), "In Beton", "Op Beton") & Choose(Sheets(1).Range("R6"), " - Manueel", "- Automatisatie")).Copy ActiveWorkbook

    For Each fl In CreateObject("scripting.filesystemobject").getfolder("\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen").Files
        c0 = c0 & "|" & fl.Name
    Next
    .SaveAs "\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen\BE08" & Format(UBound(Filter(Filter(Split(c0, "|"), ".xls"), "BE08")) - 13, "0000") & "_" & "Devos" & ".xlsx"
    .SaveAs "\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen\BE08" & Format(UBound(Filter(Filter(Split(c0, "|"), ".xls"), "BE08")) - 13, "0000") & "_" & "Nestor" & ".xlsx"
    .SaveAs "\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen\BE08" & Format(UBound(Filter(Filter(Split(c0, "|"), ".xls"), "BE08")) - 13, "0000") & "_" & "Came" & ".xlsx"
    .Close False

    MsgBox "De opgeslagen bestellingen staan in: " & "\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen"
   
End Sub

 

[snitsel]

zet svp. je code hier.
Te oordelen aan de melding heb je meer dan eens dezelfde variabele gedeclareerd.

Dim c0 as string
--------

Dim c0 as string

-------
Set c0 as Range

etc.

Hallo

Ik had zojuist mijn bestand terug nodig en heb de nodige aanpassingen in mijn code aangebracht.
Alleen heb ik nu nog 1 probleem.

Ik wil dus 3 tabbladen in een nieuw werkboek plaatsen en automatisch opslaan op een andere locatie met het eerst volgend verhogend nummer.

Mijn eerste bestand slaat hij automatisch op met het volgende nummer
alleen het 2de en 3de bestand slaat hij op met een veel te hoog nummer.

info: in mijn map met bestellingen heb ik 13 standaard bestellingen staan, dus vandaar -12 in de code. mijn laatste bestand noemt BE080291

Als ik het bestand in de bijlage uitvoer, gebeurd er dus het volgende
Bestandsnaam bestand 1: BE080292

en dan loopt het fout
Bestandsnaam bestand 2: BE080598
Bestandsnaam bestand 3: BE080905

Ik versta echt niet wat er gaande is in mijn code.
Kan er mij iemand verder helpen?

 

[snb]

1 advies: gebruik zo min mogelijk gekopieerde VBA-code van Internet.
Gebruik code alleen als je volledig begrijpt wat die doet.
Ontwerp bij voorkeur je eigen code.
Uit de reeks 292, 598, 905 kun je al afleiden wat er mis gaat.

 

[snitsel]

Het is gewoon raar dat alles goed gaat met het eerste bestand en vervolgens de rest begint te flippen.
Weet je toevallig niet waar ik even gemist heb in mijn bestand?

als ik inderdaad mijn eigen code maak en dus in de 2de code -306 zet zal het wss wel juist opslaan, maar dan weet ik nog niet wat de fout is in mijn vorige code.

groetjes

 

[snb]

Als je eenmaal het volgnummer van het eerste bestand hebt bepaald, dient voor het volgende bestand aan dat aantal + 1 toegevoegd te worden. Dat gebeurt niet in jouw code: een kwestie van nauwkeurig lezen en begrijpen wat de code doet.

 

[snitsel]

Als je eenmaal het volgnummer van het eerste bestand hebt bepaald, dient voor het volgende bestand aan dat aantal + 1 toegevoegd te worden. Dat gebeurt niet in jouw code: een kwestie van nauwkeurig lezen en begrijpen wat de code doet.

Dag SNB, wel ik heb dat geprobeerd, maar toch komen er andere getallen tevoorschijn.
Ik heb nu mijn code aangepast met in de eerste code
-10
en bij de volgende code heb ik gewoon het verschil genomen van wat hij nam als volgnummer.
Als ik vervolgens nog eens op de knop druk, dan loopt het terug mis en neemt hij het volgnummer niet maar terug met een verschil.
Ik wil het trouwens opslaan als een gewone .xls omdat er mensen zijn die het moeten openen met een oudere versie van excel en als ik in mijn code de extensie aanpas dan krijg ik zelf en die andere gebruiker de volgende foutmelding:

Het bestand dat u wilt openen, 'BE080920_Came.xls', heeft niet de bestandindeling die wordt aangegeven met de bestandsextensie. Controleer of het bestand onbeschadigd is en of het afkomstig is van een vertrouwde bron voordat u het opent. wilt u het bestand openen?

Als ik "Ja" klik kan ik het openen maar de gebruikers met excel 2003 krijgen rare tekens.

 

[snitsel]

Beste

Het probleem was nog steeds niet opgelost.
Ik werk namelijk met Excel 2007 en gebruikers Excel 2003 konden mijn bestand niet normaal openen. Nu heb ik mijn code aangepast, maar telkens hij mijn bestand wilt opslaan in een 97-2003 formaat, dan krijg ik eerst een melding "Compatibiliteitscontrole" en als ik op "doorgaan" klik, dan verloopt het goed.
Ik wil dus natuurlijk niets telkens op "Doorgaan" klikken en ik probeerde de volgende code nog toe te passen:
SendKeys "{ENTER}"

Maar dit heeft precies geen effect.

Moet ik dit doen met een SendKeys? of ben ik beter met een code om deze controle even uit te schakelen en daarna terug in te schakelen?

Mvg

 

[snitsel]

Kan er mij aub nog iemand verder helpen?

Vriendelijke groeten

 

[snitsel]

Moet ik de SendKeys uitvoeren of moet ik ergens "alerts" uitschakelen via VBA en vervolgens na de code uit te voeren deze weer inschakelen?

Mvg

 

[snitsel]

Ik heb het dus gevonden via de code toe te voegen:

Application.DisplayAlerts = True
Application.DisplayAlerts = False

Alleen weet ik niet hoe ik meerdere tabbladen in mijn werkboek kan kopiëren naar een apart nieuw werkboek.
Ik heb dus 3 tabbladen in 1 werkboek die elk apart gekopieerd moeten worden in telkens 1 apart werkboek.
Kan er mij hier iemand nog mee verder helpen?
In mijn code hier sla ik dus 1 tabblad op in een nieuw werkboek met het 1st verhogend nummer in een aangewezen map.
Wat kan ik toevoegen als ik het zelfde wil doen voor het tabblad "Came" en "Nestor"?

'Opslaan van de Bestelling DEVOS in \\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen met het eerst volgende verhoogde nummer

    Sheets("Devos").Select

'Working in Excel 97-2007

'--> DIM staat bovenaan

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
        
        Application.DisplayAlerts = False

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

        'Change all cells in the worksheet to values if you want
        With Destwb.Sheets(1).UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
        End With
        Application.CutCopyMode = False

    'Save the new workbook and close it
    For Each fl In CreateObject("scripting.filesystemobject").getfolder("\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen").Files
        c0 = c0 & "|" & fl.Name
    Next
    ActiveWorkbook.SaveAs "\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen\BE08" & Format(UBound(Filter(Filter(Split(c0, "|"), ".xls"), "BE08")) - 11, "0000") & "_" & "Devos", FileFormat:=56
    
    With Destwb
        '.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close SaveChanges:=False
    End With

    MsgBox "You can find the new file in " & "\\Flsrv-01\Bestellingen TD\2008\Collstrop\Bestellingen"

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
        Application.DisplayAlerts = False
End Sub