MS ACCESS MAILING LIST: Re: [belajar-access] hide Property sheet dalam design view (form)

Wa'alaikumussalam Wr Wb,

Dear Mas Ronny, secara normal, design view selalu memungkinkan kita masuk ke area editing properties. Selain itu, VBA pun hanya aktif dalam mode run, setelah masuk ke mode design view, secara otomatis VBA tidak aktif.

Namun bila kita memang harus melakukan ketidaklaziman ini disebabkan hal-hal dan kondisi tertentu, maka kita dapat melakukan beberapa langkah sebagaimana yang Insya Allah akan saya jabarkan sbb:

- Siapkan file Access baru untuk latihan, katakanlah namanya "HidePropertySheet.accdb"

- Buatlah Form1 dan Form2, kosong tanpa isi.

- Pada design view Form1, set Timer Interval ke 1000, kemudian pada class modulenya tambahkan:

Option Compare Database

'----------------------------------------------------------------

' Module : modSwitchPropertySheet

' Author : Pavlo Pedan

' Date : 31/07/2009

' Purpose : DoCmd.RunCommand acCmdProperties only toggles Property Sheet in

' : Form/Report Design View on/off. Use function below to turn it

' : on or off

'----------------------------------------------------------------

Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _

(ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _

ByVal lpszClass As String, ByVal lpszWindow As String) As Long

Private Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, _

lpRect As RECT) As Long

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Function fSwitchPropertySheet(blnON As Boolean) As Boolean

'----------------------------------------------------------------

' Procedure : fSwitchPropertySheet

' Author : Pavlo Pedan

' Date : 31/07/2009

' Purpose : switch Property Sheet in Design View (blnON = False to turn off)

'----------------------------------------------------------------

Dim frm As Form

Dim hWnd As Long

Dim rectControl As RECT

' create temp form

Set frm = CreateForm

' find handle for Property Sheet window

hWnd = FindWindowEx(Application.hWndAccessApp, 0, "MsoCommandBarDock", _

"MsoDockRight")

If hWnd > 0 Then

' get coordinates of the window

GetWindowRect hWnd, rectControl

' determine action

If blnON Then

' if window width is 0, switch it ON

If rectControl.Left = rectControl.Right Then

DoCmd.RunCommand acCmdProperties

'returns True if action made

fSwitchPropertySheet = True

End If

Else

' if window width is not 0, switch it OFF

If rectControl.Left <> rectControl.Right Then

DoCmd.RunCommand acCmdProperties

'returns True if action made

fSwitchPropertySheet = True

End If

' close temp form without saving

DoCmd.Close , , acSaveNo

End Function

Private Sub Form_Timer()

fSwitchPropertySheet (False)

End Sub

- Save Form1, kemudian buatlah Macro Autoexec, set sbb:

- Close dan jalankan macro Autoexec.

- Kemudian masuk ke design view Form2. Maka kini sheet properties tampil hanya sesaat dalam setiap penampakannya.

Namun tidak direkomendasikan penggunaan metode ini, sebab kemungkinan user malah jadi penasaran, mengapa properties antara ada dan tiada, jadinya mereka dikhawatirkan malah menjadi ingin klak-klik sana-sini karena rasa penasaran. Walhasil, jadi pada di klik design view semua object yang ada di Access :)

Alternatif lainnya:

- Set Access user menjadi Access Runtime, namun masalahnya jadi tidak bisa design :)

- Beri password pada VBA

- Disable "Use Access Special Keys" dll seperti pada gambar sbb:

Wassalaamu'alaikum Warahmatullahi Wabarakatuh,
Sofyan Efendi
http://imopi.wordpress.com | http://trendmuslim.com
Access Course by Request: http://wp.me/PW3LC-hR

----- Original Message -----

From: mac ba

To: belajar-access@yahoogroups.com

Sent: Thursday, December 13, 2012 3:26 PM

Subject: Re: [belajar-access] hide Property sheet dalam design view (form)

Assalamu'alaikum...
Satu lagi nih mas Sofyan..unek unek soal access nya...boleh ya ? ! kira kira mungkin ga ya kita meng-hidden property sheet dgn coding VBA meskipun pada saat dalam tampilan Design view..(maksudnya untuk kepentingan review tata letak design form aja) tetapi kita tidak ingin ada user lain yang menghapus event procedure yanga ada atau setting lainnya yang sudah kita buat di property sheet..

Wassalam.

--- On Thu, 12/13/12, mac ba <macba2000id@yahoo.com> wrote:

From: mac ba <macba2000id@yahoo.com>
Subject: Re: [belajar-access] Memunculkan ip address pc atau user name dalam text box
To: belajar-access@yahoogroups.com
Date: Thursday, December 13, 2012, 2:20 PM

Alhamdulillahirrobbil alamin...
terima kasih buat Mas Sofyan atas module dan pencerahannya..semoga Allah SWT membalas kebaikan Mas Sofyan,amiin..

Wassalam,

Ronny (mac)

--- On Thu, 12/13/12, Sofyan Efendi <sofyanefendi@gmail.com> wrote:

From: Sofyan Efendi <sofyanefendi@gmail.com>
Subject: Re: [belajar-access] Memunculkan ip address pc atau user name dalam text box
To: belajar-access@yahoogroups.com
Date: Thursday, December 13, 2012, 1:23 PM

Dear Mas Mac, bisa dicoba membuat membuat module baru sbb:

Option Compare Database
Option Explicit

' ******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const AF_INET = 2

Private Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(MAX_WSADescription) As Byte
szSystemStatus(MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type

Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type

Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

' returns the standard host name for the local machine
Private Declare Function apiGetHostName _
Lib "wsock32" Alias "gethostname" _
(ByVal NamE As String, _
ByVal nameLen As Long) _
As Long

' retrieves host information corresponding to a host name
' from a host database
Private Declare Function apiGetHostByName _
Lib "wsock32" Alias "gethostbyname" _
(ByVal hostname As String) _
As Long

' retrieves the host information corresponding to a network address
Private Declare Function apiGetHostByAddress _
Lib "wsock32" Alias "gethostbyaddr" _
(addr As Long, _
ByVal dwLen As Long, _
ByVal dwType As Long) _
As Long

' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

' converts a string containing an (Ipv4) Internet Protocol
' dotted address into a proper address for the IN_ADDR structure
Private Declare Function apiInetAddress _
Lib "wsock32" Alias "inet_addr" _
(ByVal cp As String) _
As Long

' function initiates use of Ws2_32.dll by a process
Private Declare Function apiWSAStartup _
Lib "wsock32" Alias "WSAStartup" _
(ByVal wVersionRequired As Integer, _
lpWsaData As WSADATA) _
As Long

Private Declare Function apilstrlen _
Lib "kernel32" Alias "lstrlen" _
(ByVal lpString As Long) _
As Long

Private Declare Function apilstrlenW _
Lib "kernel32" Alias "lstrlenW" _
(ByVal lpString As Long) _
As Long

' function terminates use of the Ws2_32.dll
Private Declare Function apiWSACleanup _
Lib "wsock32" Alias "WSACleanup" _
() As Long

Function fGetHostIPAddresses(strHostName As String) As Collection
'
' Resolves the English HostName and returns
' a collection with all the IPs bound to the card
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpHostEnt As HOSTENT
Dim strOut As String
Dim colOut As Collection
Dim lngIPAddr As Long
Dim abytIPs() As Byte
Dim i As Integer

Set colOut = New Collection

If fInitializeSockets() Then
strOut = String$(255, vbNullChar)
lngRet = apiGetHostByName(strHostName)
If lngRet Then

Call sapiCopyMem( _
lpHostEnt, _
ByVal lngRet, _
Len(lpHostEnt))

Call sapiCopyMem( _
lngIPAddr, _
ByVal lpHostEnt.hAddrList, _
Len(lngIPAddr))

Do While (lngIPAddr)
With lpHostEnt
ReDim abytIPs(0 To .hLength - 1)
strOut = vbNullString
Call sapiCopyMem( _
abytIPs(0), _
ByVal lngIPAddr, _
.hLength)
For i = 0 To .hLength - 1
strOut = strOut & abytIPs(i) & "."
Next
strOut = Left$(strOut, Len(strOut) - 1)
.hAddrList = .hAddrList + Len(.hAddrList)
Call sapiCopyMem( _
lngIPAddr, _
ByVal lpHostEnt.hAddrList, _
Len(lngIPAddr))
If Len(Trim$(strOut)) Then colOut.Add strOut
End With
Loop
End If
End If
Set fGetHostIPAddresses = colOut
ExitHere:
Call apiWSACleanup
Set colOut = Nothing
Exit Function
ErrHandler:
With Err
MsgBox "Error: " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, _
.Source
End With
Resume ExitHere
End Function

Function fGetHostName(strIPAddress As String) As String
'
' Looks up a given IP address and returns the
' machine name it's bound to
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpAddress As Long
Dim strOut As String
Dim lpHostEnt As HOSTENT

If fInitializeSockets() Then
lpAddress = apiInetAddress(strIPAddress)
lngRet = apiGetHostByAddress(lpAddress, 4, AF_INET)
If lngRet Then
Call sapiCopyMem( _
lpHostEnt, _
ByVal lngRet, _
Len(lpHostEnt))
fGetHostName = fStrFromPtr(lpHostEnt.hName, False)
End If
End If
ExitHere:
Call apiWSACleanup
Exit Function
ErrHandler:
With Err
MsgBox "Error: " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, _
.Source
End With
Resume ExitHere
End Function

Private Function fInitializeSockets() As Boolean
Dim lpWsaData As WSADATA
Dim wVersionRequired As Integer

wVersionRequired = fMakeWord(2, 2)
fInitializeSockets = ( _
apiWSAStartup(wVersionRequired, lpWsaData) = 0)

End Function

Private Function fMakeWord( _
ByVal low As Integer, _
ByVal hi As Integer) _
As Integer
Dim intOut As Integer
Call sapiCopyMem( _
ByVal VarPtr(intOut) + 1, _
ByVal VarPtr(hi), _
1)
Call sapiCopyMem( _
ByVal VarPtr(intOut), _
ByVal VarPtr(low), _
1)
fMakeWord = intOut
End Function

Private Function fStrFromPtr( _
pBuf As Long, _
Optional blnIsUnicode As Boolean) _
As String
Dim lngLen As Long
Dim abytBuf() As Byte

If blnIsUnicode Then
lngLen = apilstrlenW(pBuf) * 2
Else
lngLen = apilstrlen(pBuf)
End If
' if it's not a ZLS
If lngLen Then
ReDim abytBuf(lngLen)
' return the buffer
If blnIsUnicode Then
'blnIsUnicode is True not tested
Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
fStrFromPtr = abytBuf
Else
ReDim Preserve abytBuf(UBound(abytBuf) - 1)
Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
fStrFromPtr = StrConv(abytBuf, vbUnicode)
End If
End If
End Function

Public Function GetMyIP()
GetMyIP = fGetHostIPAddresses(fOSMachineName()).Item(1)
End Function

Function fOSMachineName() As String
'Returns the computername
Dim lngLen As Long, lngX As Long
Dim strCompName As String
lngLen = 16
strCompName = String$(lngLen, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function
'******************** Code End **************************

Kemudian pada text box IP bisa isi control source nya menjadi IP:GetMyIP()
Dan pada text box PC Name bisa isi control source nya menjadi Nama PC:
fOSMachineName()

Wassalaamu'alaikum Warahmatullahi Wabarakatuh,
Sofyan Efendi
http://imopi.wordpress.com | http://trendmuslim.com
Access Course by Request: http://wp.me/PW3LC-hR
----- Original Message -----
From: "mac" <macba2000id@yahoo.com>
To: <belajar-access@yahoogroups.com>
Sent: Thursday, December 13, 2012 12:35 PM
Subject: [belajar-access] Memunculkan ip address pc atau user name dalam
text box

> Siang, para master Access..
> Mohon bimbingan dan pencerahan serta sample programnya (kalo ada) apabila
> kita ingin memunculkan ip address dari PC yang sedang kita gunakan atau
> boleh juga user name PC tsb, saya sudah coba dengan coding
> =environ("computername") tapi hasilnya malah #name../gak muncul
> Sebagai info,saya menggunakan access 2007, sebelumnya saya pernah buat
> dengan access 2003 dan codingnya bisa berjalan (ip muncul)
>
> Terima kasih sebelumnya,
>
>
>
> ------------------------------------
>
> SPAM IS PROHIBITEDYahoo! Groups Links
>
>
>