Opslaan en volgnummer verhogen

[Commander]

Dag,

Voor onze administratie wil ik graag het invoerblad opslaan en dan automatisch een volgnummer geven aan dit blad.

Ik heb op het forum gekeken en deze code gevonden;
Private Sub Workbook_Open()
Dim x, cl
x = -1
cl = Dir("D:\2011\*")
Do Until cl = ""
x = x + 1
cl = Dir
Loop
With [Blad1!A1]
.Value = IIf(x > 0, x + 1, 1)
.NumberFormat = "2011-000"
End With
End Sub

Toch doet deze niet helemaal wat ik wil.

Wie kan mij helpen?

Ik kan goed plakken en knippen.

Groet Richard.

 

[HSV]

De map die in de 'F' partitie staat, heet 'uitrukken 2011' ?

Wat mankeert eraan Richard.

 

[Commander]

Dag HSV,

Dank voor je snelle reactie.

Volgens mij snap ik niet helemaal hoe deze code werkt.
Als ik namelijk het bestand opsla verandert het nummer niet.

Voor deze lijsten is de bedoeling dat ze een uniek nummer krijgen, gerelateerd aan het jaar bijvoorbeeld uitruk 2011-001 enz. Het mooiste is dat ze opgeslagen worden in uitrukmap 2011. En het liefst met een knop verwerkt in de lijst.

De code die ik gevonden heb, doet wel zoiets (volgens het voorbeeld dan) maar niet helemaal.

Ik hoop dat ik de bedoelling zo duidelijk heb gemaakt.

groet Richard.

 

[Gert Bouwmeeste]

Richard,

Zie deze vraag van mij en de oplossing:
http://www.helpmij.nl/forum/showthread.php/614459-Volgend-factuurnr-bepalen-a.d.h.v.-reeds-bestaande-factuurnummers-in-een-map

Ik kan nu niet bij m'n eigen computer, maar ik heb 'm subliem werkend. Is hetzelfde wat jij wil, maar dan voor facturen. Zal morgen even proberen de juiste code te plaatsen.

 

[Commander]

Dag Gert,

Ik had deze inderdaad ook gezien, maar vond deze erg ingewikkeld. Ik begin bepaalde onderdelen te begrijpen, maar weet niet precies wat waar te plaatsen.
Kun je dat aangeven, de verwijzingen naar mappen ed begrijp ik wel.

Dank voor je reactie trouwens.

Groet Richard.

 

[Commander]

opslaan en doornummeren

Dag,

Ik heb de code van Gert ingevoegd. De bedoeling is dat dit blad opgeslagen wordt met een doornummering dus 2011-001 (001 is de beginwaarde). Dit gebeurt niet.

Het blad heet Uitruklijst , het excelbestand heet administratie post 1.
Als ik steeds hetzelfde bestand gebruikt (het orgineel) dan moet er dus een volgnummer wijzigen (2011-001 enz). Ergens doe ik iets verkeerd.

Graag aanwijzigingen of suggesties.

Groet Richard.

 

[HSV]

Dit is niet de code van Gert Commander.

 

[Gert Bouwmeeste]

Dit is niet de code van Gert

Nee, dat is het idd niet. Ik zal even kijken of ik dit weekend tijd heb de code te plaatsen. Beetje hectisch hier Voorjaar hé?

 

[Warme bakkertje]

Plaats deze in ThisWorkbook

Option Explicit
Const MijnPad = "F:\Uitruk "                              'directory waar de documenten staan

Private Sub Workbook_Open()
  Dim Nr As Integer, Pad As String, c1 As String, x As String, Naam As String, i As Integer
  Dim Omschr As String
  Omschr = Year(Date) & "-"                         'zoek naar documentnrs van het huidige jaar
  Pad = MijnPad & Year(Date) & IIf(Right(MijnPad, 1) <> "\", "\", "")
  c1 = Dir(Pad & Omschr & "*.xls*")                        'zoek xls-files (en xlsm,xlsx, ...) die beginnen met bovenstaande omschrijving
  Do Until c1 = ""                                         'zoeken tot je alle files langsgelopen hebt
    x = Replace(c1, Omschr, "")                            'verwijder omschrijving
    i = InStr(1, x, ".xls")                                'nu nog de file-extensie
    If i > 0 Then x = Left(x, i - 1)
    If IsNumeric(x) Then                                   'is wat overblijft nog numeric
      Nr = WorksheetFunction.Max(Nr, CInt(x))              'zoek hoogste nummer tot nogtoe
    End If
    c1 = Dir
  Loop

  Naam = Omschr & Format(Nr + 1, "000")                    'naam van het document
  [Uitruklijst!C1].Value = Naam
End Sub

En als je dan deze nog vervangt wordt je werkblad en uitgeprint en een kopie opgeslagen in de dir F:\Uitruk 2011

Private Sub CommandButton1_Click()
With Sheets("Uitruklijst")
    .PrintOut Copies:=1, Collate:=True
    .Copy
    With ActiveWorkbook
        .Sheets(1).UsedRange.Copy
        .Sheets(1).[A1].PasteSpecial xlPasteValues
        .SaveAs "F:\Uitruk " & Year(Date) & "\" & [c1] & ".xls"
        .Close False
    End With
End With
End Sub

 

[Commander]

Dag,

Iedereen hartelijk bedankt voor de hulp, ga dit vannavond even proberen.

Groet Richard

 

[Commander]

Dag,

Ik heb de wijzigingen ingevoerd. Toch werkt het nog niet zo als ik dat graag wil.
De ingevoerde lijst wordt niet met volgnummer 2011-001 enz. opgeslagen. De lijst wordt opgeslagen als map2.
Verder hoef ik deze lijst niet altijd te printen. Wel versturen per e-mail. Kan ik de printcode ook wijzigen naar opslaan?

De code werkt, daarvoor dank.
Wat moet ik nog veranderen om deze naar mijn wensen aan te passen?

Groet Richard

 

[Commander]

opslaan en doornummeren

O,ja ik voeg nog even een bijlage bij.

 

[Warme bakkertje]

Plaats deze in ThisWorkbook

De code werkt wel zoals jij het graag wil, jij hebt het alleen niet toegepast zoals het aangegeven wordt. WAAR is de macro in ThisWorkbook ?????
Deze zorgt voor de nummering bij het openen v/h bestand. Als deze ontbreekt ( zoals dit het geval is) zal er idd niets doorgenummerd worden. Het is ZEER belangrijk dat je de gegeven antwoorden regel per regel grondig leest zodat je alles doet zoals het gezegd wordt

 

[Commander]

Inderdaad, er gebeurd wel iets. er wordt wel opgeslagen, maar dan steeds als map 1 enz. Deze map wordt steeds opgeslagen als werkmap zonder macro.
Maak het uit dat ik 2010 gebruik ipv 2003, ik sla wel op als 2003 werkmap met macro.

Als ik dit goed begrijp zit het hem in een instelling in mijn excel 2010 en niet in de code.
De code klopt toch, zoals hij is gebruikt?

Groet Richard.

 

[Commander]

opslaan en doornummeren

Ik heb nog even de bijlage toegevoegd.
Inmiddels heb ik excel aangepast en macro opslaan geselecteerd.
Bestand wordt wel opgeslagen maar dan als map1 enz.
Dit moet dus 2011-001 enz worden, ook moet er doorgenummerd worden in de uitruklijst zelf, dus ook 2011-001 enz.

Ik heb alles nog even goed doorgekeken, maar weet eigelijk niet meer wat ik verkeerd doe. Plakken en knippen is niet genoeg zie ik wel.

Groet Richard


uploaden lukt niet, bestand ongeldig

 

[Warme bakkertje]

Bijlage werkt 100% in XL2003 op voorwaarde dat de doelmap F:\Uitrukken 2011 heet.
Bij het openen wordt gecontroleerd op aanwezigheid van eventuele bestanden en het nummer aangepast in C1.
Als je nu op de knop verzenden drukt wordt het bestand in de juiste map en onder de juiste naam opgeslagen. Het verzenden heb ik even uitgeschakeld, verwijdeer de aanhalingstekens voor de groene regels om dit terug in te schakelen.
Test eens bij jou en laat even weten waar het juist fout loopt.

 

[Commander]

opslaan en doornummeren

Dag,

Krijg een aantal meldingen;

(zie bijlage).

er wordt wel opgeslagen maar met map naam map 1 enz.

Groet Richard

 

[Warme bakkertje]

Wijzig eens in deze

.SaveAs "F:\Uitrukken " & Year(Date) & "\" & [c1] & ".xlsm", 52

Ik kan het niet testen, heb geen 2010 en geen 2007 voorhanden momenteel. Het is iig in deze regel dat je de oplossing moet maken.

 

[Commander]

opslaan en doornummeren

Dag,

Heb de code gewijzigd, opslaan lukt, maar nog steeds als map1 enz.
Krijg steeds de melding (vb) en daarna begint de foutopsporing (zie vb4).

Op de een of andere manier slaat excel niet op met macro terwijl ik dat wel heb ingesteld.
Ook de doelmap wordt niet gevonden.

Ben even 4 dagen niet aanwezig, dus zal niet reageren. Hulp wordt gewaardeerd.

Groet Richard

 

[Commander]

opslaan en doornummeren

Dag,

Ben nog steeds bezig met mijn probleem (uitdaging?).
Op zich werkt het doornummeren wel maar dan nog steeds als map1 enz.
Krijg wel nog steeds de melding dat er moet worden opgeslagen als map met macro's.
Als ik dit instel in opslaan als, moet dit toch altijd werken?
Of moet ik nog iets aanpassen in de code? De knop verzenden geeft deze melding standaard.

Ik gebruik 2010, maar het programmaatje moet ook werken onder 2003 en 2007.

Groet Richard