Rowan Drummond, Don Guillet,
I have it working! Now I go sleep
(1:43 in Europe, I get up at 6:30
)
Below is the final code of the whole shebang. You suggestion to use
"=MAX(NieuwArtikelNr!D5
300,1)" did not work out since NieuwArtikelNr
is, yes indeed, a sheetname but a variable one. So I got a browsewindow
every time I tried to use that.
Did not feel like translating anymore so I hope you understand what was
going in here.
I learned a lot from this, thanks for suggestions and thinking along!
Sleep well,
Henro
-------------------code---------------------
Sub nieuweartikelen()
'
' VolgendArtikel Macro
' De macro is op 6-11-2005 opgenomen en aangepast door Henro Veijer.
'
' Sneltoets: CTRL+SHIFT+Z
'
Dim ws As Worksheet
Dim ArtVolgnummer As String
Dim NieuwArtikelNr As String
Dim ProduktCode As String
'Eerst bepalen we de naam van het nieuwe werkblad dmv 2 inputboxen
'Produktcode is de lettercombinatie (ProduktCode)
'die wordt gekoppeld aan de cijfercombinatie (Artikelvolgnummer)
'en zo wordt het artikelnummer bepaald (NieuwArtikelNr)
ProduktCode = InputBox("Geef de produktsoort op" & Chr(10) & Chr(10) &
"HardWare = hw" & Chr(10) & "SoftWare = sw", "Produktsoort")
Artikelvolgnummer = InputBox("Geef het nieuwe artikelnummer op" &
Chr(10) & Chr(10) & "9999", "Artikelnummer")
NieuwArtikelNr = ProduktCode & Artikelvolgnummer
'We controleren op geldigheid van de input
For Each ws In Worksheets
'Eerst controleren op een bestaande naam
If ws.Name = NieuwArtikelNr Then
MsgBox "Artikelnummer bestaat reeds", vbInformation
GoTo FoutMelding
'Dan controleren of Produktcode ingevuld is
ElseIf NieuwArtikelNr = Artikelvolgnummer Then
MsgBox "Geen produktsoort opgegeven", vbInformation
GoTo FoutMelding
'Dan controleren of ArtikelVolgnummer ingevuld is
ElseIf NieuwArtikelNr = ProduktCode Then
MsgBox "Geen artikelvolgnummer opgegeven", vbInformation
GoTo FoutMelding
End If
Next
'Voorwaarden zijn gekozen, we gaan nu het werkblad fabrieken
Maken:
'We kopieren de sheet 'blanco'
Sheets("blanco").Copy Before:=Sheets(1)
'We plaatsen de sheet achteraan en hernoemen de sheet
With ActiveSheet
.Move After:=Worksheets(Worksheets.Count)
.Name = NieuwArtikelNr
End With
'Invullen van de artikelnaam in de sheet
Sheets(NieuwArtikelNr).Select
Range("B1").Select
ActiveCell.Formula = NieuwArtikelNr
' Plaatsen artikelnummer op hoofdblad
Sheets("hoofdblad").Select
Range("A1").End(xlDown).Offset(1, 0).Formula = NieuwArtikelNr
'Plaatsen van de juiste formules in het 'Hoofdblad'
Sheets("hoofdblad").Select
Range("B2").End(xlDown).Offset(1, 0).Formula = "=" & NieuwArtikelNr
& "!$A$3"
Range("C2").End(xlDown).Offset(1, 0).Formula = "=COUNTA(" &
NieuwArtikelNr & "!$A$6:$A$50)<=COUNTA(" & NieuwArtikelNr &
"!$D$6:$D$50)"
Range("D2").End(xlDown).Offset(1, 0).Formula = "=MAX(" &
NieuwArtikelNr & "!A5:A300,1)" & " + 90"
Range("E2").End(xlDown).Offset(1, 0).Formula = "=COUNTA(" &
NieuwArtikelNr & "!$A$6:$A$50)<=COUNTA(" & NieuwArtikelNr &
"!$D$6:$D$50)"
Range("F2").End(xlDown).Offset(1, 0).Formula = "_"
Range("G2").End(xlDown).Offset(1, 0).Formula = "=COUNTA(" &
NieuwArtikelNr & "!$C$6:$C$50)"
Range("H2").End(xlDown).Offset(1, 0).Formula = "=COUNTA(" &
NieuwArtikelNr & "!$A$6:$A$50)"
Range("I2").End(xlDown).Offset(1, 0).Formula = "=" & NieuwArtikelNr
& "!$D$3"
Range("J2").End(xlDown).Offset(1, 0).Formula = "=" & NieuwArtikelNr
& "!$D$3" & " + 365"
GoTo Uitgang
'Foutafhandeling
FoutMelding:
MsgBox "Er is geen nieuw artikel aangemaakt, probeer opnieuw!",
vbCritical
'We verlaten het pand
Uitgang:
End Sub