Note: The other languages of the website are Google-translated. Back to English
English English

Bagaimana cara menyimpan dan menutup buku kerja setelah tidak aktif untuk jangka waktu tertentu?

Terkadang, Anda mungkin secara tidak sengaja menutup buku kerja saat Anda sibuk dengan urusan lain dalam waktu lama yang mungkin kehilangan beberapa data penting di buku kerja. Apakah ada trik untuk menyimpan dan menutup buku kerja secara otomatis jika Anda telah menonaktifkannya selama jangka waktu tertentu?

Simpan otomatis dan tutup buku kerja setelah tidak aktif selama jangka waktu tertentu dengan VBA


panah gelembung kanan biru Simpan otomatis dan tutup buku kerja setelah tidak aktif selama jangka waktu tertentu dengan VBA

Tidak ada fungsi bawaan di Excel untuk mengatasi masalah ini, tetapi saya dapat memperkenalkan kode makro yang dapat membantu Anda menyimpan dan menutup buku kerja setelah tidak ada aktivitas dalam waktu tertentu.

1. Aktifkan buku kerja yang ingin Anda simpan dan tutup secara otomatis setelah tidak ada aktivitas selama beberapa detik, dan tekan Alt + F11 kunci untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. klik Menyisipkan > Modul untuk membuat a Modul script, dan tempel kode di bawah ini. Lihat tangkapan layar:

Dim CloseTime As Date
Sub TimeSetting()
    CloseTime = Now + TimeValue("00:00:15")
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=False
 End Sub
Sub SavedAndClose()
    ActiveWorkbook.Close Savechanges:=True
End Sub

 

doc simpan tutup buku kerja setelah tidak ada aktivitas 1

3. Kemudian di Penjelajah Proyek panel, klik dua kali Buku Kerja ini, dan tempel kode di bawah ini ke skrip samping. Lihat tangkapan layar:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call TimeStop
End Sub

Private Sub Workbook_Open()
    Call TimeSetting
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Call TimeStop
   Call TimeSetting
End Sub

 

doc simpan tutup buku kerja setelah tidak ada aktivitas 2

4. Pergi ke klik dua kali pada modul yang Anda masukkan pada langkah 2, dan tekan F5 kunci untuk menjalankan kode. Lihat tangkapan layar:
doc simpan tutup buku kerja setelah tidak ada aktivitas 3

5. Kemudian setelah 15 detik, ada dialog muncul untuk mengingatkan Anda menyimpan workbook, dan klik Yes untuk menyimpan dan menutup buku kerja.
doc simpan tutup buku kerja setelah tidak ada aktivitas 4

Tip:

(1) Di kode pertama, Anda dapat mengubah waktu tidak aktif ke lainnya dalam string ini: Now + TimeValue ("00:00:15")

(2) Jika Anda belum pernah menyimpan buku kerja sebelumnya, file Save As kotak dialog akan keluar terlebih dahulu dan meminta Anda untuk menyimpannya.
doc simpan tutup buku kerja setelah tidak ada aktivitas 5


baik Lindungi Lembar Kerja

Kutools untuk Excel Lindungi Lembar Kerja fungsi dapat dengan cepat melindungi beberapa lembar atau seluruh buku kerja sekaligus.
doc melindungi banyak lembar kerja

Alat Produktivitas Kantor Terbaik

Kutools for Excel Memecahkan Sebagian Besar Masalah Anda, dan Meningkatkan Produktivitas Anda hingga 80%

  • Reuse: Masukkan dengan cepat rumus, bagan yang kompleks dan apa pun yang pernah Anda gunakan sebelumnya; Enkripsi Sel dengan kata sandi; Buat Milis dan mengirim email ...
  • Bilah Formula Super (dengan mudah mengedit beberapa baris teks dan rumus); Membaca Tata Letak (membaca dan mengedit sel dalam jumlah besar dengan mudah); Tempel ke Rentang yang Difilter...
  • Gabungkan Sel / Baris / Kolom tanpa kehilangan Data; Pisahkan Konten Sel; Gabungkan Baris / Kolom Duplikat... Mencegah Sel Duplikat; Bandingkan Rentang...
  • Pilih Duplikat atau Unik Baris; Pilih Baris Kosong (semua sel kosong); Temukan Super dan Temukan Fuzzy di Banyak Buku Kerja; Pilih Acak ...
  • Salinan Tepat Beberapa Sel tanpa mengubah referensi rumus; Buat Referensi Otomatis ke Beberapa Lembar; Sisipkan Poin, Kotak Centang, dan lainnya ...
  • Ekstrak Teks, Tambahkan Teks, Hapus berdasarkan Posisi, Hapus Space; Membuat dan Mencetak Subtotal Paging; Konversi Konten Antar Sel dan Komentar...
  • Filter Super (simpan dan terapkan skema filter ke sheet lain); Penyortiran Lanjutan menurut bulan / minggu / hari, frekuensi dan lainnya; Filter Khusus dengan huruf tebal, miring ...
  • Gabungkan Workbooks dan WorkSheets; Gabungkan Tabel berdasarkan kolom kunci; Pisahkan Data menjadi Beberapa Lembar; Konversi Batch xls, xlsx dan PDF...
  • Lebih dari 300 fitur canggih. Mendukung Office / Excel 2007-2019 dan 365. Mendukung semua bahasa. Penerapan yang mudah di perusahaan atau organisasi Anda. Fitur lengkap uji coba gratis 30 hari. Jaminan uang kembali 60 hari.
tab kte 201905

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Tingkatkan produktivitas Anda hingga 50%, dan kurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah
Urutkan komentar berdasarkan
komentar (11)
Belum ada peringkat. Jadilah yang pertama memberi peringkat!
Komentar ini diminimalkan oleh moderator di situs
Kode di atas tidak berfungsi saat sel aktif. Itu adalah

1. masukkan nilai dalam sel (jangan tekan Enter atau tab)

2. meminimalkan excel.

Dalam hal ini kode tidak berfungsi.
Komentar ini diminimalkan oleh moderator di situs
Jika Anda bekerja di buku kerja terpisah pada titik di mana waktu dekat tercapai maka itu akan menutup buku kerja itu dan bukan yang tidak aktif. Ini dapat diselesaikan dengan menyesuaikan kode ke:

Redupkan CloseTime Sebagai Tanggal
Redupkan WKB Sebagai String
Pengaturan Waktu Sub()
WKB = ActiveWorkbook.Nama
CloseTime = Sekarang + TimeValue("00:00:15")
On Error Resume Next
Application.OnTime EarliestTime:=WaktuTutup, _
Prosedur:="TersimpanDanTutup", Jadwal:=Benar
End Sub
SubWaktuBerhenti()
On Error Resume Next
Application.OnTime EarliestTime:=WaktuTutup, _
Prosedur:="TersimpanDanTutup", Jadwal:=Salah
End Sub
Sub DisimpanDanTutup()
Workbooks(WKB).Tutup SimpanPerubahan:=Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Saya memperhatikan hal yang sama. Dan menemukan solusi yang sama :-)
Komentar ini diminimalkan oleh moderator di situs
Saya terkadang mengalami "Running time Error" ketika membuka buku kerja yang memiliki kode ini di dalamnya. Pokoknya untuk menulis kode ini lebih baik agar lebih stabil?
Komentar ini diminimalkan oleh moderator di situs
brilian terima kasih
Komentar ini diminimalkan oleh moderator di situs
hai saya ingin memasukkan kode ini ke kode lain seperti kode kedaluwarsa dengan kode ini bagaimana saya bisa melakukannya ....?
kode adalah ... berikut
Sub Workbook_Open Pribadi ()

Peredupan Exdate Sebagai Tanggal
Redupkan saya Sebagai Integer

'modifikasi nilai untuk tanggal kedaluwarsa di sini !!!
anul = 2019 'tahun
luna = 5 'bulan
ziua = 16 'hari

exdate = DateSerial(anul, luna, ziua)

Jika Tanggal > exdate Kemudian
MsgBox ("Aplikasi " & ThisWorkbook.Name & " telah kedaluwarsa !" & vbNewLine & vbNewLine _
& "Tanggal pengaturan kedaluwarsa adalah: " & exdate & " :)" & vbNewLine & vbNewLine _
& "Hubungi Administrator untuk memperbarui versi !"), vbCritical, ThisWorkbook.Name

expired_file = ThisWorkbook.Path & "\" & ThisWorkbook.Name

Pada Kesalahan GoTo ErrorHandler
Dengan Buku Kerja (Buku Kerja Ini.Nama)
Jika .Jalur <> "" Kemudian

.Disimpan = Benar
.UbahFileAccess xlReadOnly

Bunuh expired_file

'dapatkan nama addin jika itu addin dan unistall addin
Jika Aplikasi.Versi >= 12 Kemudian
i = 5
Lain: i = 4
End If

If Right(ThisWorkbook.Name, i) = ".xlam" Atau Right(ThisWorkbook.Name, i) = ".xla" Kemudian
wbName = Kiri(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
'uninstall addin jika sudah terpasang
Jika AddIns(wbName).Diinstal Kemudian
AddIns(wbName).Dipasang = Salah
End If
End If

.Menutup

End If
Berakhir dengan

Keluar dari Sub

End If

'MsgBox ("Anda memiliki " & exdate - Tanggal & "Hari tersisa")
Keluar dari Sub

ErrorHandler:
MsgBox "Gagal menghapus file.."
Keluar dari Sub

End Sub
Komentar ini diminimalkan oleh moderator di situs
Jika Anda bekerja di buku kerja terpisah pada titik di mana waktu dekat tercapai maka itu akan menutup buku kerja itu dan bukan yang tidak aktif. Ini dapat diselesaikan dengan menyesuaikan kode ke: - dikoreksi dan diuji dari komentar di bawah ini - gunakan kode ini:

Masuk ke "Buku Kerja Ini"

Sub Workbook_BeforeClose Pribadi (Batalkan Sebagai Boolean)
Panggilan Waktu Berhenti
End Sub
Sub Workbook_Open Pribadi ()
Pengaturan Waktu Panggilan
End Sub
Sub Workbook_SheetChange Pribadi (ByVal Sh Sebagai Objek, Target ByVal Sebagai Rentang)
Panggilan Waktu Berhenti
Pengaturan Waktu Panggilan
End Sub


Masuk ke "modul":

Redupkan CloseTime Sebagai Tanggal
Pengaturan Waktu Sub()
CloseTime = Sekarang + TimeValue("00:10:00")
On Error Resume Next
Application.OnTime EarliestTime:=WaktuTutup, _
Prosedur:="TersimpanDanTutup", Jadwal:=Benar
End Sub
SubWaktuBerhenti()
On Error Resume Next
Application.OnTime EarliestTime:=WaktuTutup, _
Prosedur:="TersimpanDanTutup", Jadwal:=Salah
End Sub
Sub DisimpanDanTutup()
ThisWorkbook.Tutup SimpanPerubahan:=Benar
End Sub


Anda dapat mengubah pengaturan waktu dengan mengubah CloseTime = Now + TimeValue("00:10:00") - ini diatur ke 10 menit, ubah ("00:10:00") ke waktu apa pun yang Anda inginkan dan berhasil.
Komentar ini diminimalkan oleh moderator di situs
Saya tidak yakin apa yang terjadi tetapi solusi ini tidak lagi berfungsi. Inilah perbaikan untuk solusi ini yang berhasil untuk saya:

````
Atur ulang redup, Hitung Selamanya

Buku Kerja Sub Publik_Open()
On Error Resume Next
Tetapkan xWB = Buku Kerja Ini
ulang Hitung = 0
End Sub

Private Sub Workbook_SheetChange(ByVal Sh Sebagai Objek, ByVal Target Sebagai Rentang)Pada Kesalahan Lanjutkan Berikutnya
ulang
End Sub

Sub Reset () Pada Kesalahan Lanjutkan Selanjutnya
xCloseTime Statis
Jika resetCount <> 0 Kemudian
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Jadwal:=Salah
resetCount = resetHitung + 1
xCloseTime = DateAdd("n", 15, Sekarang)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Jadwal:=Benar

Lain
resetCount = resetHitung + 1
xCloseTime = DateAdd("n", 15, Sekarang)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Jadwal:=Benar
End If
End Sub
````
Ini menggunakan SaveWork1 As yang sama:
````Sub SaveWork1()
Application.DisplayAlerts = Salah
Buku Kerja ini.Simpan
Buku Kerja ini.Tutup

Application.DisplayAlerts = Benar
End Sub

````
Komentar ini diminimalkan oleh moderator di situs
Ini bagus. Adakah tip untuk menambahkan kotak pesan sembulan yang akan memperingatkan pengguna bahwa lembar akan ditutup dan memberi mereka opsi untuk mengatur ulang penghitung waktu?
Komentar ini diminimalkan oleh moderator di situs
Ketika saya tidak ingin mengedit dan saya hanya ingin berkonsultasi, file tetap tertutup. Seharusnya tidak menutup. Harus memulai kembali penghitungan ketika saya memilih sel. Apa solusinya?
Komentar ini diminimalkan oleh moderator di situs
Ketika saya tidak ingin mengedit dan saya hanya ingin berkonsultasi, file tetap tertutup. Seharusnya tidak menutup. Harus memulai kembali penghitungan ketika saya memilih sel. Apa solusinya?
Belum ada komentar yang diposting di sini
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan