VBA en tabellen en autonummering
Janette
nummer in zetten. Het nummer kan een formule zijn: de waarde van de cel
erboven +1 of een autonummer maar dan moet het wel aan een aantal
voorwaarden voldoen: ik moet zelf aan kunnen geven vanaf welk getal er
geteld moet worden (en dat is niet 1).
Wie weet de codes voor "zoek lege cel" en voor "waarde=vorige cel + 1" of
"autonummer invoegen"(het nummer is 6 cijfers, de eerste twee staan voor het
jaar en de andere vier voor het autonummer)
Alvast bedankt voor de hulp
J.G. Kok
De onderstaande code laat je een eerste waarde invullen en vervolgens wordt
bij elke keer uitvoeren de eerstvolgende lege cel in de eerste kolom met 1
verhoogd t.o.v. de cel er boven.
Sub AutoNummerInKolom()
Dim tbl As Table
Dim intAantal As Integer
Dim i As Integer
Dim rng As Range
Set tbl = ActiveDocument.Tables(1)
intAantal = tbl.Columns(1).Cells.Count
'alle cellen in de kolom doorlopen tot een lege gevonden wordt
For i = 1 To intAantal
'als de cel leeg is dan niet verder zoeken
If Len(tbl.Columns(1).Cells(i).Range) = 2 Then
Exit For
End If
Next i
If i = 1 Then
'voor de eerste cel in de kolom een waarde aangeven
tbl.Columns(1).Cells(i).Range = InputBox("Geef uw beginwaarde",
"Nummeren", 1)
ElseIf i = intAantal + 1 Then
MsgBox "Het einde van de kolom is bereikt", , "Nummeren"
Else
'de lege cel de waarde geven van de cel erboven +1
tbl.Columns(1).Cells(i).Range = Val(tbl.Columns(1).Cells(i -
1).Range) + 1
End If
End Sub
Misschien kun je er iets mee.
Jan
Janette
maar.....
Als het het de eerste cel van een lege tabel is, wordt er een 1 ingevuld en
komt de messagebox om zelf een waarde aan te geven niet te voorschijn.
Als ik wel een cijfer in de cel erboven neerzet, wordt er inderdaad keurig 1
bij op geteld, maar... de eerste 0 (nul) valt weg (de eerste 2 cijfers
moeten voor dit jaar altijd 01 zijn en voor volgend jaar 02 etc.). Nu kan ik
natuurlijk makkelijk opgeven dat er een automatisch 0 ingevoegd moet worden,
maar misschien heb jij een beter idee.
Is het ook mogelijk om dit cijfer in de laatste kolom te zetten? B.v. er
zijn 4 kolommen, vervang ik dan Columns(1) door Columns(4)?
Het doel van de nummers is om als referentienummer op een brief e.d. te
dienen, terwijl in de tabel wordt vastgelegd a. naar wie, b. voor welk
project, c. het referentienummer en d. op welke datum. a., b. en d. kon ik
al automatiseren maar het automatisch nummeren lukte niet.
Nogmaals bedankt
"J.G. Kok" <jg...@freeler.nl> schreef in bericht
news:esOoZYHXBHA.1548@tkmsftngp03...
J.G. Kok
Gebruik je wellicht kolomkoppen, dan is de tabel dus niet echt leeg.
Hieronder daarvoor een oplossing door te kijken of de cel boven de eerste
lege cel de waarde 0 heeft. Daarbij ben ik ervan uitgegaan dat jouw
nummering altijd uit positieve getallen zal bestaan.
Bovendien hoef je nu maar op één plek een ander tabelnummer en/of
kolomnummer te plaatsen.
Inderdaad kun je Columns(3) gebruiken voor kolom 3.
Sub AutoNummerInKolom()
Dim intAantal As Integer
Dim i As Integer
With ActiveDocument.Tables(1).Columns(4)
intAantal = .Cells.Count
'alle cellen in de kolom doorlopen tot een lege gevonden wordt
For i = 1 To intAantal
'als de cel leeg is dan niet verder zoeken
If Len(.Cells(i).Range) = 2 Then
Exit For
End If
Next i
If i = 1 Then
'voor de eerste cel in de kolom een waarde aangeven
'standaard wordt jj0001 ingevuld
.Cells(i).Range = Format(InputBox("Geef uw beginwaarde",
"Nummeren", _
Format(Date, "yy") & "0001"), "000000")
ElseIf i = intAantal + 1 Then
MsgBox "Het einde van de kolom is bereikt", , "Nummeren"
Else
'de lege cel de waarde geven van de cel erboven +1
'en de juiste notatie geven: 000000
If Val(.Cells(i - 1).Range) <> 0 Then
.Cells(i).Range = Format(Val(.Cells(i - 1).Range) + 1,
"000000")
Else
.Cells(i).Range = Format(InputBox("Geef uw beginwaarde",
"Nummeren", _
Format(Date, "yy") & "0001"), "000000")
End If
End If
End With
End Sub
Misschien is je maar ... hier voldoende beantwoord, zo niet dan hoor ik dat
wel,
Jan