8 Messages
Digest #4734
Messages
Sat Mar 16, 2019 3:53 pm (PDT) . Posted by:
"Tio Adi Bayu Adjie"
Terima kasih banyak Mr. Kid atas jawabannya semoga amal baiknya diterima Allah SWT. Amiin.
Pertanyaan lanjutan :
1. Mr. Kid menulis wbkF.Close False dimana wbkF adalah workbook yang isinya adalah nama file beserta path nya. Tapi yang saya baca di referensi lain adalah kalau menutup workbook, maka cukup dengan nama filenya saja tanpa path seperti workbooks("namafilenya.xlsx").close true. Mohon bimbingannya lagi, kapan saya harus menutup workbook dengan path dan kapan tanpa path ?
2. Berarti kalau mau tahu apakah file itu terbuka di computer saya atau di computer orang lain, saya harus buka file itu dulu ya ? Adakah code VBA yang bisa mengetahui itu tanpa harus buka file dulu ? Maaf karena file yang dibuka ukurannya besar, jadi kalau buka file dulu, maka akan lama .
3. Kalau ada kasus dengan code VBA seperti ini.
Dim Alamatfile as string
Dim Mywb as workbook,Wbbaru as workbook
Dim wbbaruSh as worksheet,MywbSh as worksheet
On error goto Keluar
Alamatfile="D:\\myfolder\mysubfolder\namafilesaya..xlsx"
'''Buka file dari server
BukaFile Alamatfile,"PasswordSaya"
Set Mywb=ThisWorkbook
Set Wbbaru=workbooks("namafilesaya.xlsx")
Wbbaru.activate
Set WbbaruSh=Wbbaru.worksheets("mySheet")
With WbbaruSh
.Cells(1,1).value="XXX"
'''Code lain…..….
End with
Mywb.activate
Set MywbSh=Mywb.worksheets("mySheetJuga")
With MywbSh
.Cells(1,1).value="YYY"
'''Code lain…
End with
Wbbaru.close true ---------------> Saya selalu error disini. Adakah yang salah dari coding saya ?padahal saya sudah modif dengan
On error resume next 'modif saya
Wbbaru.Close true 'modif saya
Err.clear 'modif saya
On error goto 0 'modif saya
Set mywb=nothing
Set wbbaru=nothing
Set wbbaruSh=nothing
Set MywbSh=nothing
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Err.Clear
On Error GoTo 0
End sub
4. Bagaimana urutan penulisan yang benar seperti contoh dibawah ini : Label dulu atau clear memory (set rg=nothing misalnya ) ?
Private sub contohsaja()
On error goto Keluar
Set myrange=range(Cells(1,1),Cells(1,100))
Set myrange=nothing
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End sub
Atau….
Private sub contohsaja()
On error goto Keluar
Set myrange=range(Cells(1,1),Cells(1,100))
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set myrange=nothing
End sub
Mana urutan penulisan yang benar. Label dulu atau clear memory (dengan set myrange=nothing) ?
5. Kalau mengurangi memory untuk range, dengan menulis diakhirnya set myRange=nothing. Bagaimana dengan worksheet apakah harus set mySheet=nothing ?
Bagaimana juga dengan ukuran variable seperti Dim L as long dan ditulis di akhirnya L=empty atau variable byte, string apakah juga ditulis myString=vbnullstring ?
6. Bagaimana clear memory untuk Public Events ? Tolong diberi contoh clear memory untuk Public Events..
Terima kasih atas bimbingannya, semoga amal baiknya diterima Allah SWT. Amiin
Tio
From: belajar-excel@yahoogroups.com [mailto:belajar-excel@yahoogroups.com]
Sent: 15 Maret 2019 9:03
To: BeExcel
Subject: Re: [belajar-excel] Cek file open di server apakah dibuka dikomputer sendiri atau di komputer orang lain
Public Sub BukaFile(Optional sFile As String, Optional sPwdOpen As String = vbNullString)
Dim sMsgTxt As String, sMsgTitle As String, lMsg As Long, lTry As Long, wbkF As Workbook
sMsgTxt = "Pembukaan ke-"
sMsgTitle = "Buka File"
lMsg = 20
If Len(sFile) * Len(Dir(sFile, vbNormal)) = 0 Then
MsgBox "File tidak ada atau tidak dapat di akses.", vbExclamation, sMsgTitle
Exit Sub
End If
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Keluar
Ulangi:
lTry = lTry + 1
Set wbkF = Workbooks.Open(sFile, 0, True, Password:=sPwdOpen, IgnoreReadOnlyRecommended:=True, Notify:=False)
wbkF.ChangeFileAccess xlReadWrite, Notify:=False
If wbkF.ReadOnly Then
wbkF.Close False
If lTry Mod lMsg > 0 Then GoTo Ulangi
If MsgBox(sMsgTxt & lTry, vbExclamation + vbRetryCancel + vbDefaultButton2, sMsgTitle & " : Read Only") = vbRetry Then GoTo Ulangi
End If
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Err.Clear
On Error GoTo 0
End Sub
Cara pakai :
BukaFile "path\file.extension","Pwd"
On Thu, Mar 14, 2019 at 5:46 AM Tio Adi Bayu Adjie tio.adjie@ptssb.co.id<mailto:tio.adjie@ptssb.co.id> [belajar-excel] <belajar-excel@yahoogroups.com<mailto:belajar-excel@yahoogroups.com>> wrote:
Dear Be-Exceller,
Saya mau cek apakah file di server dibuka oleh orang lain atau dibuka dikomputer sendiri. File itu ada di server. Saya sudah bikin code nya tapi kok gak bisa ya ? Mohon bimbingannya.
Ini code saya :
Public function sFileAdaAccess(fname) as Boolean
sFileAdaAccess = True
If IsFileOpen(fname) = True Then
Set wbbook = Workbooks(fname)
If Not wbbook.ReadOnly = True Then
MsgBox "Silahkan ditutup dulu File Master", vbExclamation, "File master terbuka"
sFileAdaAccess = false
Exit Function
Else
sFileAdaAccess = True
End If
Set wbbook = Nothing
'End If
Public Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer
Dim errnum As Integer
On Error Resume Next ' Turn error checking off..
'''''''''''''''''''''''''''''''''''''''''''
' If we were passed in an empty string,
' there is no file to test so return FALSE.
'''''''''''''''''''''''''''''''''''''''''''
If filename = vbNullString Then
IsFileOpen = False
Exit Function
End If
'''''''''''''''''''''''''''''''
' If the file doesn't exist,
' it isn't open so get out now.
'''''''''''''''''''''''''''''''
If Dir(filename) = vbNullString Then
IsFileOpen = False
Exit Function
End If
''''''''''''''''''''''''''
' Get a free file number.
''''''''''''''''''''''''''
filenum = FreeFile()
'''''''''''''''''''''''''''
' Attempt to open the file
' and lock it.
'''''''''''''''''''''''''''
Err.Clear
Open filename For Input Lock Read As #filenum
''''''''''''''''''''''''''''''''''''''
' Save the error number that occurred.
''''''''''''''''''''''''''''''''''''''
errnum = Err.Number
On Error GoTo 0 ' Turn error checking back on.
Close #filenum ' Close the file.
''''''''''''''''''''''''''''''''''''
' Check to see which error occurred.
''''''''''''''''''''''''''''''''''''
Select Case errnum
Case 0
'''''''''''''''''''''''''''''''''''''''''''
' No error occurred.
' File is NOT already open by another user.
'''''''''''''''''''''''''''''''''''''''''''
IsFileOpen = False
Case 70
''''''''&#
Pertanyaan lanjutan :
1. Mr. Kid menulis wbkF.Close False dimana wbkF adalah workbook yang isinya adalah nama file beserta path nya. Tapi yang saya baca di referensi lain adalah kalau menutup workbook, maka cukup dengan nama filenya saja tanpa path seperti workbooks("namafilenya.xlsx").close true. Mohon bimbingannya lagi, kapan saya harus menutup workbook dengan path dan kapan tanpa path ?
2. Berarti kalau mau tahu apakah file itu terbuka di computer saya atau di computer orang lain, saya harus buka file itu dulu ya ? Adakah code VBA yang bisa mengetahui itu tanpa harus buka file dulu ? Maaf karena file yang dibuka ukurannya besar, jadi kalau buka file dulu, maka akan lama .
3. Kalau ada kasus dengan code VBA seperti ini.
Dim Alamatfile as string
Dim Mywb as workbook,Wbbaru as workbook
Dim wbbaruSh as worksheet,MywbSh as worksheet
On error goto Keluar
Alamatfile="D:\\myfolder\mysubfolder\namafilesaya..xlsx"
'''Buka file dari server
BukaFile Alamatfile,"PasswordSaya"
Set Mywb=ThisWorkbook
Set Wbbaru=workbooks("namafilesaya.xlsx")
Wbbaru.activate
Set WbbaruSh=Wbbaru.worksheets("mySheet")
With WbbaruSh
.Cells(1,1).value="XXX"
'''Code lain…..….
End with
Mywb.activate
Set MywbSh=Mywb.worksheets("mySheetJuga")
With MywbSh
.Cells(1,1).value="YYY"
'''Code lain…
End with
Wbbaru.close true ---------------> Saya selalu error disini. Adakah yang salah dari coding saya ?padahal saya sudah modif dengan
On error resume next 'modif saya
Wbbaru.Close true 'modif saya
Err.clear 'modif saya
On error goto 0 'modif saya
Set mywb=nothing
Set wbbaru=nothing
Set wbbaruSh=nothing
Set MywbSh=nothing
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Err.Clear
On Error GoTo 0
End sub
4. Bagaimana urutan penulisan yang benar seperti contoh dibawah ini : Label dulu atau clear memory (set rg=nothing misalnya ) ?
Private sub contohsaja()
On error goto Keluar
Set myrange=range(Cells(1,1),Cells(1,100))
Set myrange=nothing
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End sub
Atau….
Private sub contohsaja()
On error goto Keluar
Set myrange=range(Cells(1,1),Cells(1,100))
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Set myrange=nothing
End sub
Mana urutan penulisan yang benar. Label dulu atau clear memory (dengan set myrange=nothing) ?
5. Kalau mengurangi memory untuk range, dengan menulis diakhirnya set myRange=nothing. Bagaimana dengan worksheet apakah harus set mySheet=nothing ?
Bagaimana juga dengan ukuran variable seperti Dim L as long dan ditulis di akhirnya L=empty atau variable byte, string apakah juga ditulis myString=vbnullstring ?
6. Bagaimana clear memory untuk Public Events ? Tolong diberi contoh clear memory untuk Public Events..
Terima kasih atas bimbingannya, semoga amal baiknya diterima Allah SWT. Amiin
Tio
From: belajar-excel@yahoogroups.com [mailto:belajar-excel@yahoogroups.com]
Sent: 15 Maret 2019 9:03
To: BeExcel
Subject: Re: [belajar-excel] Cek file open di server apakah dibuka dikomputer sendiri atau di komputer orang lain
Public Sub BukaFile(Optional sFile As String, Optional sPwdOpen As String = vbNullString)
Dim sMsgTxt As String, sMsgTitle As String, lMsg As Long, lTry As Long, wbkF As Workbook
sMsgTxt = "Pembukaan ke-"
sMsgTitle = "Buka File"
lMsg = 20
If Len(sFile) * Len(Dir(sFile, vbNormal)) = 0 Then
MsgBox "File tidak ada atau tidak dapat di akses.", vbExclamation, sMsgTitle
Exit Sub
End If
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Keluar
Ulangi:
lTry = lTry + 1
Set wbkF = Workbooks.Open(sFile, 0, True, Password:=sPwdOpen, IgnoreReadOnlyRecommended:=True, Notify:=False)
wbkF.ChangeFileAccess xlReadWrite, Notify:=False
If wbkF.ReadOnly Then
wbkF.Close False
If lTry Mod lMsg > 0 Then GoTo Ulangi
If MsgBox(sMsgTxt & lTry, vbExclamation + vbRetryCancel + vbDefaultButton2, sMsgTitle & " : Read Only") = vbRetry Then GoTo Ulangi
End If
Keluar:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Err.Clear
On Error GoTo 0
End Sub
Cara pakai :
BukaFile "path\file.extension","Pwd"
On Thu, Mar 14, 2019 at 5:46 AM Tio Adi Bayu Adjie tio.adjie@ptssb.co.id<mailto:tio.adjie@ptssb.co.id> [belajar-excel] <belajar-excel@yahoogroups.com<mailto:belajar-excel@yahoogroups.com>> wrote:
Dear Be-Exceller,
Saya mau cek apakah file di server dibuka oleh orang lain atau dibuka dikomputer sendiri. File itu ada di server. Saya sudah bikin code nya tapi kok gak bisa ya ? Mohon bimbingannya.
Ini code saya :
Public function sFileAdaAccess(
sFileAdaAccess = True
If IsFileOpen(fname) = True Then
Set wbbook = Workbooks(fname)
If Not wbbook.ReadOnly = True Then
MsgBox "Silahkan ditutup dulu File Master"
sFileAdaAccess = false
Exit Function
Else
sFileAdaAccess = True
End If
Set wbbook = Nothing
'End If
Public Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer
Dim errnum As Integer
On Error Resume Next ' Turn error checking off..
''&#
' If we were passed in an empty string,
' there is no file to test so return FALSE.
''&#
If filename = vbNullString Then
IsFileOpen = False
Exit Function
End If
''&#
' If the file doesn't exist,
' it isn't open so get out now.
''&#
If Dir(filename) = vbNullString Then
IsFileOpen = False
Exit Function
End If
''&#
' Get a free file number.
''&#
filenum = FreeFile()
''&#
' Attempt to open the file
' and lock it.
''&#
Err.Clear
Open filename For Input Lock Read As #filenum
''&#
' Save the error number that occurred.
''&#
errnum = Err.Number
On Error GoTo 0 ' Turn error checking back on.
Close #filenum ' Close the file.
''&#
' Check to see which error occurred.
''&#
Select Case errnum
Case 0
''&#
' No error occurred.
' File is NOT already open by another user.
''&#
IsFileOpen = False
Case 70
''&#