Script til Excel

Er der tale om et rent nummererings-system - d.v.s. fragtbrevene er i printeren og der skal indsættes samme nummer i 3 celler - herefter udskrives arket.
Dette gentages 100 gange.

I så fald kan processen styres via en Userform (programmeret dialog-boks), hvor der er mulighed for at indsætte/korrigere blanketnr.

Er det sådant?

ja det er det men de 100 der udskrives skal have 100 nummer dvs. fra 00000 - 00100 = 1 print 1 nummer ingen fragtbreve må have samme nummer

J7 / J53/ J94 er det på eet eller 3 fragtbreve

det er på 1

Koden i userform:

Rem Version 1 - 10-12-2008
Rem ======================
Dim fragtBrevNr
Private Sub CommandButton1_Click()                  'udskriv
    For antal = 1 To Val(Me.TextBox2)
       
        Application.StatusBar = "Eks.nr.: " & CStr(antal) & " udskrives"          'vis aktuelle nr
       
        With ActiveWorkbook.Sheets(1)
            .Range("J7").Value = Me.TextBox1
            .Range("J53").Value = Me.TextBox1
            .Range("J94").Value = Me.TextBox1
           
            .PrintOut                              'et fragtbrev udskrives
        End With
       
        optælNr                                    'optæl nummer
        fragtBrevNr = hentNummer
        Me.TextBox1 = formaterNr(fragtBrevNr)
    Next antal
   
Rem Workbook gemmes.....
    ActiveWorkbook.Save
   
    MsgBox ("Udskrivning afsluttet")
End Sub
Private Sub CommandButton2_Click()                  'annuller
    Unload UserForm1
End Sub
Private Sub TextBox2_Change()
    If Me.TextBox2 <> "" And IsNumeric(Me.TextBox2) = True Then
        Me.CommandButton1.Enabled = True
    Else
        Me.CommandButton2.Enabled = False
    End If
End Sub
Private Sub UserForm_activate()
    Application.StatusBar = ""
   
Rem hent første nummer
    fragtBrevNr = hentNummer
    Me.TextBox1 = formaterNr(fragtBrevNr)
   
    Me.TextBox2 = hentAntal
End Sub
Private Function hentNummer()                          'næste fragtbrev-nr
    hentNummer = CStr(ActiveWorkbook.Sheets(2).Cells(1, 2))
End Function
Private Function hentAntal()                            'standard antal
    hentAntal = CStr(ActiveWorkbook.Sheets(2).Cells(2, 2))
End Function
Private Function formaterNr(nr)
    formaterNr = Format(nr, "00000")
End Function
Private Sub optælNr()
    With ActiveWorkbook.Sheets(2)
        .Cells(1, 2) = .Cells(1, 2) + 1
    End With
End Sub

Jeg takker meget

Selv tak..