belom pernah coba mas. dan setelah dicoba eeeehh BERHASIL!! hehehe.... Thanks bantuannya. :)
Reza ________________________________ From: "[email protected]" <[email protected]> To: [email protected] Sent: Friday, May 18, 2012 8:40 AM Subject: Re: [belajar-excel] run makro terhenti krn klik mouse Pernah coba dgn property Interactive mode? set ke False, dan jgn lupa set lagi ke true di akhir script. Excel will block all input from the keyboard and mouse (except dialog boxes that are set in your code) Application.interactive = True / False Powered by Telkomsel BlackBerry® ________________________________ From: Reza F <[email protected]> Sender: [email protected] Date: Thu, 17 May 2012 18:17:19 -0700 (PDT) To: [email protected]<[email protected]> ReplyTo: [email protected] Subject: Re: [belajar-excel] run makro terhenti krn klik mouse Makasi tanggapannya. Hehehe... boleh diliat kok, wong saya juga ngambil dari milis ini VBAnya. Ini VBAnya: Private Sub CommandButton3_Click() Dim lOffset As Long Dim rngData As Range Dim sMsg As String Dim lNewRec As Long Dim shtTrn1 As Worksheet Dim shtTrn2 As Worksheet Dim shtTrn3 As Worksheet Dim shtTrn4 As Worksheet Dim shtTrn5 As Worksheet Dim shtTrn6 As Worksheet Dim shtTrn7 As Worksheet Dim shtTrn8 As Worksheet Application.EnableEvents = False Application.ScreenUpdating = False Proteksi ActiveSheet, False Set shtTrn1 = Sheets("PsnTrx") shtTrn1.Visible = xlSheetVisible Set shtTrn2 = Sheets("ListTrx") shtTrn2.Visible = xlSheetVisible Set shtTrn3 = Sheets("DrgTrx") shtTrn3.Visible = xlSheetVisible Set shtTrn4 = Sheets("LbrTrx") shtTrn4.Visible = xlSheetVisible Set shtTrn5 = Sheets("Transaksi") Proteksi shtTrn5, False shtTrn5.Visible = xlSheetVisible Set shtTrn6 = Sheets("Macem2") shtTrn6.Visible = xlSheetVisible Set shtTrn7 = Sheets("Kasir") Set shtTrn8 = Sheets("Laporan Bulanan") sMsg = vbNullString If Range("K5").Value = 0 Then sMsg = "- No Register" & vbCrLf If Range("F35").Value = 0 Then sMsg = sMsg & "- Bayar" & vbCrLf If Range("D4").Value = 0 Then sMsg = sMsg & "- Diagnosa" & vbCrLf 'cek jika smsg ada isinya, berarti ada yang belum diisi If LenB(sMsg) <> 0 Then MsgBox "Hal-hal yang BELUM diisi :" & vbCrLf & sMsg & vbCrLf & _ "Coba diperbaiki lebih dulu!!" & vbCrLf & vbCrLf, vbExclamation, "Peringatan !!!" Application.CommandBars.ActiveMenuBar.Enabled = False Application.DisplayFullScreen = True Application.CommandBars("Full Screen").Enabled = False ActiveSheet.EnableSelection = xlUnlockedCells Sheets("Transaksi").EnableSelection = xlUnlockedCells Proteksi ActiveSheet Proteksi Sheets("Transaksi") Proteksi Sheets("Laporan Bulanan") shtTrn1.Visible = xlSheetVeryHidden shtTrn2.Visible = xlSheetVeryHidden shtTrn3.Visible = xlSheetVeryHidden shtTrn4.Visible = xlSheetVeryHidden shtTrn6.Visible = xlSheetVeryHidden ActiveSheet.EnableSelection = xlUnlockedCells Exit Sub End If sMsg = vbNullString sMsg = vbNullString If Range("L5").Value = 0 Then sMsg = "- Kode Pelayanan" & vbCrLf If Range("M5").Value = 0 Then sMsg = sMsg & "- Kode Obat" & vbCrLf If Range("N5").Value = 0 Then sMsg = sMsg & "- Kode Lab" & vbCrLf If LenB(sMsg) <> 0 Then If MsgBox("Hal-hal yang 'TIDAK/BELUM' diisi :" & vbCrLf & sMsg & vbCrLf & _ "Akan diperbaiki lebih dulu ?" & vbCrLf & vbCrLf & _ "Tekan YES untuk memperbaiki lebih dulu" & vbCrLf & _ "Tekan NO untuk melanjutkan", vbYesNo, "Peringatan !!!") = vbYes Then ActiveSheet.EnableSelection = xlUnlockedCells Proteksi ActiveSheet Proteksi Sheets("Transaksi") shtTrn1.Visible = xlSheetVeryHidden shtTrn2.Visible = xlSheetVeryHidden shtTrn3.Visible = xlSheetVeryHidden shtTrn4.Visible = xlSheetVeryHidden shtTrn6.Visible = xlSheetVeryHidden ActiveSheet.EnableSelection = xlUnlockedCells Exit Sub End If sMsg = vbNullString End If shtTrn6.Select shtTrn6.PageSetup.PrintArea = "V11:AG27" ActiveWindow.SelectedSheets.PrintOut shtTrn7.Select If MsgBox(" Kembalian = Rp " & Sheets("Kasir").Range("D38").Value & vbCrLf & vbCrLf & _ " " & vbCrLf & vbCrLf & _ " Ada yang mau di perbaiki lagi?", vbYesNo, "Konfirmasi") = vbYes Then ActiveSheet.EnableSelection = xlUnlockedCells Proteksi ActiveSheet Proteksi Sheets("Transaksi") shtTrn1.Visible = xlSheetVeryHidden shtTrn2.Visible = xlSheetVeryHidden shtTrn3.Visible = xlSheetVeryHidden shtTrn4.Visible = xlSheetVeryHidden shtTrn6.Visible = xlSheetVeryHidden ActiveSheet.EnableSelection = xlUnlockedCells Exit Sub End If 'TRANSAKSI ActiveSheet.Calculate lOffset = Range("O3").Value lNewRec = Range("O5").Value If lNewRec > 0 Then Range("K82:X82").Copy Range("K84").Resize(lNewRec) 'ActiveSheet.Calculate End If Set rngData = Range("K83") If rngData.Value <> 0 Then rngData.Offset(1, 2).CurrentRegion.Copy shtTrn5.Range("a1").Offset(lOffset).PasteSpecial xlPasteValuesAndNumberFormats Else End If 'PSN-TRX ActiveSheet.Calculate lOffset = Range("K3").Value lNewRec = Range("K5").Value If lNewRec > 0 Then Range("K45:X45").Copy Range("K47").Resize(lNewRec) End If Set rngData = Range("K46") If rngData.Value <> 0 Then rngData.Offset(1, 2).CurrentRegion.Copy shtTrn1.Range("a1").Offset(lOffset).PasteSpecial xlPasteValuesAndNumberFormats End If 'LIST-TRX lOffset = Range("L3").Value lNewRec = Range("L5").Value If lNewRec > 0 Then Range("K50:W50").Copy Range("K52").Resize(lNewRec) End If Set rngData = Range("K51") If rngData.Value <> 0 Then rngData.Offset(1, 2).CurrentRegion.Copy shtTrn2.Range("a1").Offset(lOffset).PasteSpecial xlPasteValuesAndNumberFormats Else End If 'DRG-TRX lOffset = Range("M3").Value lNewRec = Range("M5").Value If lNewRec > 0 Then Range("K59:W59").Copy Range("K61").Resize(lNewRec) End If Set rngData = Range("K60") If rngData.Value <> 0 Then rngData.Offset(1, 2).CurrentRegion.Copy shtTrn3.Range("a1").Offset(lOffset).PasteSpecial xlPasteValuesAndNumberFormats Else End If 'LBR-TRX lOffset = Range("N3").Value lNewRec = Range("N5").Value If lNewRec > 0 Then Range("K73:W73").Copy Range("K75").Resize(lNewRec) 'ActiveSheet.Calculate End If Set rngData = Range("K74") If rngData.Value <> 0 Then rngData.Offset(1, 2).CurrentRegion.Copy shtTrn4.Range("a1").Offset(lOffset).PasteSpecial xlPasteValuesAndNumberFormats Else End If 'Printing If MsgBox("Minta Kwitansi?", vbYesNo, "Print Kwitansi") = vbYes Then shtTrn6.Select shtTrn6.PageSetup.PrintArea = "V31:AH47" ActiveWindow.SelectedSheets.PrintOut End If shtTrn7.Select ActiveSheet.Calculate Range("B4").ClearContents Range("D4:F4").ClearContents Range("K47:X47").ClearContents lNewRec = Range("L5").Value If lNewRec > 0 Then Range("B6:B10").ClearContents Range("K52:W56").ClearContents End If lNewRec = Range("M5").Value If lNewRec > 0 Then Range("B14:B23").ClearContents Range("E14:E23").ClearContents Range("K61:W70").ClearContents End If lNewRec = Range("N5").Value If lNewRec > 0 Then Range("B27:B30").ClearContents Range("K75:W78").ClearContents End If Range("K84:X93").ClearContents Range("F35").ClearContents shtTrn1.Visible = xlSheetVeryHidden shtTrn2.Visible = xlSheetVeryHidden shtTrn3.Visible = xlSheetVeryHidden shtTrn4.Visible = xlSheetVeryHidden shtTrn6.Visible = xlSheetVeryHidden ActiveSheet.EnableSelection = xlUnlockedCells Sheets("Transaksi").EnableSelection = xlUnlockedCells Proteksi shtTrn7 Proteksi shtTrn5 Proteksi shtTrn8 Application.ScreenUpdating = True Application.EnableEvents = True Application.CutCopyMode = False Application.CommandBars.ActiveMenuBar.Enabled = False Application.DisplayFullScreen = True Application.CommandBars("Full Screen").Enabled = False ActiveWorkbook.Save End Sub ________________________________ From: Markonah <[email protected]> To: [email protected] Sent: Thursday, May 17, 2012 10:56 PM Subject: Re: [belajar-excel] run makro terhenti krn klik mouse 'alaikum salam.. tiada dokter mampu mendiagnose suatu penyakit (kemudian memberikan tindakan &/ obatnya) tanpa melihat pasiennya. kalau dukun mungkin bisa... ada kemungkinan VBA Script anda (yg tidak boleh dilihat orang itu) mengandung statement "DoEvents"; hilangkan / ubahlah menjadi 'remark' dengan menambahkan karakter ' (aphostrof) atau kata Rem di depannya 2012/5/17 Reza F <[email protected]> >Assalamualaikum teman2 semua dan pengasuh milis be excel... >Saya punya problem seperti ini.. >Saya punya makro yg cukup panjang untuk menyimpan hasil dari sheet input ke >beberapa sheet database yg sudah disiapkan. Selama ini tidak ada masalah >dengan makro tersebut (makro hasil utak atik dari milis ini :)), hanya saja >saat makro tersebut sedang berproses (run) dan saya klik mouse, proses makro >menjadi berhenti yg mengakibatkan data dari sheet input tidak seluruhnya dapat >tersimpan ke sheet database. Ini bagaimana caranya ya agar saat mouse ter-klik >tapi proses makro dapat tetap berjalan hingga selesai? Apakah ada tambahan >kode makronya? >Terima kasih bantuannya. >Reza
