Re: [belajar-excel] Debug dan restart my workbook

[ppc lambda]

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. 
  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