Ops, ada koreksi pada baris :
* lTotalPage = w1 / lRecPerPage*
menjadi :
* lTotalPage = w1 / lRecPerPage + 1*
Kid.
On Mon, Dec 5, 2011 at 15:33, Kid Mr. <mr.nm...@gmail.com> wrote:
> 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
>
>
>
