Nama sheet di baris sSht = "SPKL" disesuaikan jadi spki atau apa itu yang anda miliki.
Kid. On Mon, Dec 5, 2011 at 16:02, ppc lambda <ppc...@sami.co.id> wrote: > ** > > > ** > > Mr Kid setelah saya Replace code yang lama dengan yang di buatkan Mr kid > ternyata masih error pada bagian ThisWorkbook.Sheets(sSht).Copy > before:=WAdd.Sheets(1) > mohon bantuannya para pakar Excel > > Terimakasih > Best Regard > <>.<>.<>.<>.<>.<>. > Sidoel > > ----- Original Message ----- > *From:* Kid Mr. <mr.nm...@gmail.com> > *To:* belajar-excel@yahoogroups.com > *Sent:* Monday, December 05, 2011 3:33 PM > *Subject:* Re: [belajar-excel] Debug dan restart my workbook > > > > 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 > > > >