Ini Kode nya sudah saya rapikan!
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim relatifPath As String
Dim sh As Worksheet
Dim shtrans As Worksheet
Application.EnableEvents = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.IgnoreRemoteRequests = False
Application.EnableCancelKey = xlDisabled
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
Application.OnKey "%{F11}"
If Not ActiveWorkbook.MultiUserEditing Then
Set shtrans = ThisWorkbook.Sheets("TRANSAKSI")
shtrans.Activate
shtrans.Visible = -1
shtrans.Select
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "TRANSAKSI" Then
sh.Visible = 2
End If
Next sh
Range("A1").Select
Application.DisplayAlerts = False

ActiveWorkbook.KeepChangeHistory = False
ActiveWorkbook.ProtectSharing Sharingpassword:="pass"
relatifPath = ThisWorkbook.Path & "\" & ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=relatifPath, FileFormat:= _ xlExcel12,
AccessMode:=xlShared
Application.DisplayAlerts = True
End if
Excel.Application.Quit
End Sub


Pada 29 Oktober 2014 00.00, Walsoyo <soyomak...@gmail.com> menulis:


> Mohon maaf emailnya berantakan, saran dari Mr. Kid sudah saya coba tapi
> tetep gak berhasil, kalau dicoba tersendiri dengan ukuran file yang kecil
> kode tersebut bisa jalan dan berhasil ketika workbook dibuka dalam kondisi
> macro di disabled maka file dapat tershared. namung jika saya pakai untuk
> file yang ukurannya besar tidak berhasil. dari pengamatan saya proses
> Saving berjalan terputus tidak sampai mentok. Ukuran file yang saya buat
> 3,5 byte. mohon pemecahanya bersama-sama!
>
> Pada 28 Oktober 2014 16.51, 'Mr. Kid' mr.nm...@gmail.com [belajar-excel] <

> belajar-excel@yahoogroups.com> menulis:
>
>
>>
>> hehehe...
>> kok bisa ya bentuk emailnya jadi susah dibaca.
>>
>> ya wislah coba baris tentang save as tidak usah menyertakan file
>> formatnya. Misal :
>> thisworkbook.saveas namafilenya, accessmode:=xlshared   'save jadi nama
>> tertentu dalam namafilenya dengan mode ter-share
>>
>> thisworkbook bisa diubah menjadi activeworkbook jika memang sedang dalam
>> keadaan aktif.
>>
>> Wassalam,
>> Kid.
>>
>>
>>
>>
>>
>>
>>
>> 2014-10-26 15:02 GMT+11:00 Walsoyo soyomak...@gmail.com [belajar-excel] <
>> belajar-excel@yahoogroups.com>:
>>
>>>
>>>
>>> Mohon bantuan bagaimana agar kode VBA saya bisa jalan saat keluar dari
>>> workbook pada mode protect sharing workbook. permasalahan yang terjadi jika
>>> setelah kode penyimpanan FilesaveAs... kemudian dilanjutkan dengan

>>> Excel.Application.Quit. Workbook saya setelah dibuka kembali dalam kondisi
>>> macro di disabled ternyata shared workbook tidak protect. tolong dilengkapi
>>> kode saya agar shared workbook protect saat kondisi macro dinonaktifkan dan
>>> unsharing workbook saat macro enabled Private Sub
>>> Workbook_BeforeClose(Cancel As Boolean) Dim relatifPath As String Dim sh As
>>> Worksheet Dim shtrans As Worksheet Application.EnableEvents = True
>>> Application.ScreenUpdating = False Application.Calculation =
>>> xlCalculationManual Application.IgnoreRemoteRequests = False
>>> Application.EnableCancelKey = xlDisabled
>>> ThisWorkbook.VBProject.VBE.MainWindow.Visible = False Application.OnKey
>>> "%{F11}" If Not ActiveWorkbook.MultiUserEditing Then Set shtrans =
>>> ThisWorkbook.Sheets("TRANSAKSI") shtrans.Activate shtrans.Visible = -1
>>> shtrans.Select For Each sh In ThisWorkbook.Worksheets If sh.Name <>
>>> "TRANSAKSI" Then sh.Visible = 2 End If Next sh Range("A1").Select
>>> Application.DisplayAlerts = False ActiveWorkbook.KeepChangeHistory = False
>>> ActiveWorkbook.ProtectSharing Sharingpassword:="pass" relatifPath =
>>> ThisWorkbook.Path & "\" & ActiveWorkbook.Name ActiveWorkbook.SaveAs
>>> Filename:=relatifPath, FileFormat:= _ xlExcel12, AccessMode:=xlShared
>>> Application.DisplayAlerts = True End if Excel.Application.Quit End Sub dan
>>> pada saat workbook dibuka macro tidak jalan Private Sub Workbook_Open() 'If
>>> ActiveWorkbook.MultiUserEditing Then Application.DisplayAlerts = False
>>> Application.DisplayAlerts = False ActiveWorkbook.UnprotectSharing
>>> Sharingpassword:="pass" Application.DisplayAlerts = True
>>> Application.DisplayAlerts = True 'End If End Sub
>>>
>>
>>
>>
>
>

Kirim email ke