hehehe...
ternyata ada attachment yang disusulkan.
Kira-kira scriptnya demikian :
Private Sub Cmb_Generate_Click()
Dim Rng As Range
Dim sSht As String
Dim W As Long, w1 As Long, aw As Long, hal As Long
Dim lRecPerPage As Long, lTotalPage As Long
'aw = 0
'hal = 1
'init object kerja
Set WAdd = ActiveWorkbook
Set Rng = WAdd.Sheets(1).Range("b2").CurrentRegion
w1 = Rng.Rows.Count - 1
If w1 < 1 Then
Exit Sub
End If
Set Rng = Rng.Offset(1).Resize(w1)
'init konstanta
sSht = "SPKL"
lRecPerPage = 30
lTotalPage = w1 / lRecPerPage
'loop create page
For W = 0 To w1 - 1 Step lRecPerPage
'If W Mod 30 = 0 Or w1 = 1 Then
'ThisWorkbook.Sheets("SPKL").Copy Before:=WAdd.Sheets(1)
hal = hal + 1 'init page number
'With WAdd
'drop existing sheet target
'On Error Resume Next
'If Not .Sheets(sSht & hal) Is Nothing Then
' Application.DisplayAlerts = False
' .Sheets(sSht & hal).Delete
' Application.DisplayAlerts = True
'End If
'Err.Clear
'On Error GoTo 0
'create new sheet target
ThisWorkbook.Sheets(sSht).Copy before:=WAdd.Sheets(1)
Set SAdd = ActiveSheet
SAdd.Name = sSht & hal
'End With
'write page main fields
With SAdd
.Range("i5") = cmb_area.Value
.Range("i6") = txt_atasan.Value
.Range("C6") = lbl_tgl.Caption
.Range("C41") = w1
.Range("i60") = hal & " Dari " & lTotalPage
End With
'init current page record count
If W + lRecPerPage > w1 Then
aw = w1 - W
Else
aw = lRecPerPage
End If
'w1 = w1 + 1
'hal = hal + 1
'End If
'write data record
If aw > 0 Then
With SAdd.Range("A10").Resize(aw)
'nomor urut
.Formula = "=row()-9"
.Calculate
.Value = .Value
.Offset(0, 2).Value = Format(txt_scan.Value, "'000000")
.Offset(0, 5).Value = Left(txt_jam, 5)
.Offset(0, 6).Value = Right(txt_jam, 5)
End With
End If
'aw = aw + 1
Next
End Sub
Kid.
On Mon, Dec 5, 2011 at 15:13, Kid Mr. <mr.nm...@gmail.com> wrote:
> Private Sub Cmb_Generate_Click()
> Dim Rng As Range
> Dim sSht As String
> Dim W As Long, w1 As Long, aw As Long, hal As Long
> Dim lRecPerPage As Long, lTotalPage As Long
>
> 'aw = 0
> 'hal = 1
>
> 'init object kerja
> Set wadd = ActiveWorkbook
> Set Rng = wadd.Sheets(1).Range("b2")
> Set Rng = wadd.Sheets(1).Range(Rng, Rng.End(xlDown)) 'asumsi :
> tidak mungkin terjadi record berjumlah 0
>
> 'init konstanta
> sSht = "SPKL"
> lRecPerPage = 30
> w1 = Rng.Rows.Count
> lTotalPage = w1 / lRecPerPage
>
> 'loop create page
> For W = 0 To w1 - 1 Step lRecPerPage
> 'If W Mod 30 = 0 Or w1 = 1 Then
>
> 'ThisWorkbook.Sheets("SPKL").Copy Before:=WAdd.Sheets(1)
>
> hal = hal + 1 'init page number
>
> With wadd
> 'drop existing sheet target
> On Error Resume Next
> If Not .Sheets(sSht & hal) Is Nothing Then
> Application.DisplayAlerts = False
> .Sheets(sSht & hal).Delete
> Application.DisplayAlerts = True
> End If
> Err.Clear
> On Error GoTo 0
>
> 'create new sheet target
> .Sheets(sSht).Copy after:=.Sheets(1)
> Set sadd = ActiveSheet
> sadd.Name = sSht & hal
> End With
>
> 'write page main fields
> With sadd
> .Range("i5") = cmb_area.Value
> .Range("i6") = txt_atasan.Value
> .Range("C6") = lbl_tgl.Caption
> .Range("C41") = w1
> .Range("i60") = hal & " Dari " & lTotalPage
> End With
>
> 'init current page record count
> If W + lRecPerPage > w1 Then
> aw = w1 - W
> Else
> aw = lRecPerPage
> End If
> 'w1 = w1 + 1
> 'hal = hal + 1
> 'End If
>
> 'write data record
> If aw > 0 Then
> With sadd.Range("A10").Resize(aw)
> 'nomor urut
> .Formula = "=row()-9"
> .Calculate
> .Value = .Value
>
> .Offset(0, 2).Value = Format(txt_scan.Value, "'000000")
> .Offset(0, 5).Value = Left(txt_jam, 5)
> .Offset(0, 6).Value = Right(txt_jam, 5)
> End With
> End If
> 'aw = aw + 1
> Next
> End Sub
