Sudah diperbaiki :
 To: belajar-excel@yahoogroups.com
From: ppc...@sami.co.id
Date: Tue, 6 Dec 2011 10:05:32 +0700
Subject: Re: [belajar-excel] Debug dan restart my workbook


















 



  


    
      
      
      


pak sudarsono
pada cmb_Generate terdapat code  & nbsp; bila 
di tuliskan di view code menjadi warna merah dan tidak bisa di 
jalankan
jika code  & nbsp; itu dihilangkan masih terjadi error yang 
sama
berikut yang berwarna merah ketika di ketikkan di View Code (VBA 
EXCEL)
 
 &nb sp;  On Error 
Resume Next
&nb sp;   End 
If
& nbsp; .Cells(aw, 7) = 
Right(txt_jam, 5)
 
para pakar excel yang lain mohon 
bantuannya
Terimakasih
Best 
Regard
<>.<>.<>.<>.<>.<>.
Sidoel

  ----- Original Message ----- 
  From: 
  jkssxls 
  Sudarsono 
  To: Belajar-Excel Yahoo Groups 
  
  Sent: Tuesday, December 06, 2011 9:24 
  AM
  Subject: RE: [belajar-excel] Debug dan 
  restart my workbook
  
  
  
  
  karena penekanan tombol ( Start , Comm dan Generate bisa 
  sembarangan ) dapat menimbulkan looping yg tak terbatas maka 
  perlu meng- antisipasinya :
 
Private Sub 
  Cmb_Start_Click()
    'With 
  WAdd.Sheets(1).Range("A2")
    If WAdd Is Nothing Then Exit 
  Sub
    With 
  WAdd.Sheets("Sheet1").Range("A2")
        
  .Cells(L, 1) = txt_scan.Text
        
  .Cells(L, 2) = lbl_tgl.Caption
        
  .Cells(L, 3) = Left(txt_jam.Text, 
  5)
        .Cells(L, 4) = 
  Right(txt_jam.Text, 5)
        .Cells(L, 
  5) = txt_OT.Text
        .Cells(L, 6) = 
  cmb_area.Value
        .Cells(L, 7) = 
  txt_atasan.Text
         .Cells(L, 8) = 
  txt_PIC.Text
    End With
    L = L + 
  1
    txt_scan.Value = ""
    
  txt_scan.SetFocus
End Sub
 'karena copy paste memang kadang muncul karakter aneh2 
Private Sub Cmb_Generate_Click()
    Dim Rng As Range, W As Long, w1 As Long, aw As Long, hal As Long
    w1 = 1
    aw = 0
    hal = 1
    Set WAdd = ActiveWorkbook
     'Set Rng = WAdd.Sheets(1).Range("b2")
    'Set Rng = WAdd.Sheets(1).Range(Rng, Rng.End(xlDown))
    'diganti menjadi
    WAdd.Sheets("sheet1").Activate
    Set Rng = ActiveSheet.Range("b2")
    If Rng.Value = "" Then
        MsgBox "data kosong"
         Exit Sub
    End If
    
    If Rng.Offset(1, 0) <> "" Then
        Set Rng = ActiveSheet.Range(Rng, Rng.End(xlDown))
    End If
    
' batas pengantian
    For W = 1 To Rng.Rows.Count
'        If W Mod 30 = 0 Or w1 = 1 Then
'        If W Mod 30 = 0 Or hal = 1 Then
        If ((W - 1) Mod 30 = 0) Or hal = 1 Then
'       ThisWorkbook.Sheets("SPKL").Copy Before:=WAdd.Sheets(1)
'       Set SAdd = ActiveSheet
'       SAdd.Name = "SPKL" & hal
'diganti menjadi
            On Error Resume Next
            Worksheets("SPKL" & hal).Activate
            If Err.Number = 9 Then
                MsgBox "Error maka buat " & hal
                ThisWorkbook.Sheets("SPKL").Copy Before:=WAdd.Sheets(1)
                Set SAdd = ActiveSheet
                SAdd.Name = "SPKL" & hal
            Else
                Set SAdd = ActiveSheet
            End If
            On Error GoTo 0
' batas pengantian
            WAdd.Sheets(SAdd.Name).Range("i5") = cmb_area.Value
            WAdd.Sheets(SAdd.Name).Range("i6") = txt_atasan.Value
            WAdd.Sheets(SAdd.Name).Range("C6") = lbl_tgl.Caption
            WAdd.Sheets(SAdd.Name).Range("C41") = Rng.Rows.Count
'WAdd.Sheets(SAdd.Name).Range("i60") = (WorksheetFunction.Ceiling(W, 29) / 29) _
& " Dari " & (WorksheetFunction.Ceiling(Rng.Rows.Count, 29) / 29)
            w1 = w1 + 1  ' bisa digunakan hal saja
            aw = 1
'isi tiap hal/sheet adalah 29
            hal = hal + 1
            
            WAdd.Sheets(SAdd.Name).Range("A10").Select
            Range(Selection, Selection.Offset(29, 9)).ClearContents 'Select
            
        End If
        With WAdd.Sheets(SAdd.Name).Range("A10")
            .Cells(aw, 1) = W
            .Cells(aw, 3) = Format(txt_scan.Value, "'000000")
            .Cells(aw, 6) = Left(txt_jam, 5)
            .Cells(aw, 7) = Right(txt_jam, 5)
        End With
' baris berikutnya
        aw = aw + 1
    Next
End Sub
 

  
  
 
  
  
  
  
  
  
  To: belajar-excel@yahoogroups.com
From: ppc...@sami.co.id
Date: Tue, 6 
  Dec 2011 08:26:05 +0700
Subject: Re: [belajar-excel] Debug dan restart my 
  workbook

  
  
  
  Mr kid dan pak sudarsono
terimakasih atas respon nya 
  setelah saya pakai workbook dari Mr kid masih terjadi error yang 
  sama
kemudian saya coba coding nya pak jkssxls Sudarsono juga sama, masih 
  terjadi error.
saya kira komputer/excel saya yang bermasalah, saya coba di 
  komputer lain hasilnya juga error
berikut error nya
para pakar excel 
  yang lain mohon bantuannya

Terimakasih
Best 
  Regard
<>.<>.<>.<>.<>.<>.
sidoel
  
  
  
  


    
     

    
    






                                          

Reply via email to