Himmah...,
Agar tidak selalu melakukan setting regional pada tiap-tiap komputer, lebih baik disetting sewaktu loading form.
Saya dapatkan VBA dari http://www.access-programmers.co.uk/forums/showthread.php?t=206945
Option Explicit
Public AlCol As Boolean
Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal _
locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal _
cchData As Long) As Long
Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal _
locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Declare Function GetUserDefaultLCID% Lib "kernel32" ()
Public Const LOCALE_ICENTURY = &H24
Public Const LOCALE_ICOUNTRY = &H5
Public Const LOCALE_ICURRDIGITS = &H19
Public Const LOCALE_ICURRENCY = &H1B
Public Const LOCALE_IDATE = &H21
Public Const LOCALE_IDAYLZERO = &H26
Public Const LOCALE_IDEFAULTCODEPAGE = &HB
Public Const LOCALE_IDEFAULTCOUNTRY = &HA
Public Const LOCALE_IDEFAULTLANGUAGE = &H9
Public Const LOCALE_IDIGITS = &H11
Public Const LOCALE_IINTLCURRDIGITS = &H1A
Public Const LOCALE_ILANGUAGE = &H1
Public Const LOCALE_ILDATE = &H22
Public Const LOCALE_ILZERO = &H12
Public Const LOCALE_IMEASURE = &HD
Public Const LOCALE_IMONLZERO = &H27
Public Const LOCALE_INEGCURR = &H1C
Public Const LOCALE_INEGSEPBYSPACE = &H57
Public Const LOCALE_INEGSIGNPOSN = &H53
Public Const LOCALE_INEGSYMPRECEDES = &H56
Public Const LOCALE_IPOSSEPBYSPACE = &H55
Public Const LOCALE_IPOSSIGNPOSN = &H52
Public Const LOCALE_IPOSSYMPRECEDES = &H54
Public Const LOCALE_ITIME = &H23
Public Const LOCALE_ITLZERO = &H25
Public Const LOCALE_NOUSEROVERRIDE = &H80000000
Public Const LOCALE_S1159 = &H28
Public Const LOCALE_S2359 = &H29
Public Const LOCALE_SABBREVCTRYNAME = &H7
Public Const LOCALE_SABBREVDAYNAME1 = &H31
Public Const LOCALE_SABBREVDAYNAME2 = &H32
Public Const LOCALE_SABBREVDAYNAME3 = &H33
Public Const LOCALE_SABBREVDAYNAME4 = &H34
Public Const LOCALE_SABBREVDAYNAME5 = &H35
Public Const LOCALE_SABBREVDAYNAME6 = &H36
Public Const LOCALE_SABBREVDAYNAME7 = &H37
Public Const LOCALE_SABBREVLANGNAME = &H3
Public Const LOCALE_SABBREVMONTHNAME1 = &H44
Public Const LOCALE_SCOUNTRY = &H6
Public Const LOCALE_SCURRENCY = &H14
Public Const LOCALE_SDATE = &H1D
Public Const LOCALE_SDAYNAME1 = &H2A
Public Const LOCALE_SDAYNAME2 = &H2B
Public Const LOCALE_SDAYNAME3 = &H2C
Public Const LOCALE_SDAYNAME4 = &H2D
Public Const LOCALE_SDAYNAME5 = &H2E
Public Const LOCALE_SDAYNAME6 = &H2F
Public Const LOCALE_SDAYNAME7 = &H30
Public Const LOCALE_SDECIMAL = &HE
Public Const LOCALE_SENGCOUNTRY = &H1002
Public Const LOCALE_SENGLANGUAGE = &H1001
Public Const LOCALE_SGROUPING = &H10
Public Const LOCALE_SINTLSYMBOL = &H15
Public Const LOCALE_SLANGUAGE = &H2
Public Const LOCALE_SLIST = &HC
Public Const LOCALE_SLONGDATE = &H20
Public Const LOCALE_SMONDECIMALSEP = &H16
Public Const LOCALE_SMONGROUPING = &H18
Public Const LOCALE_SMONTHNAME1 = &H38
Public Const LOCALE_SMONTHNAME10 = &H41
Public Const LOCALE_SMONTHNAME11 = &H42
Public Const LOCALE_SMONTHNAME12 = &H43
Public Const LOCALE_SMONTHNAME2 = &H39
Public Const LOCALE_SMONTHNAME3 = &H3A
Public Const LOCALE_SMONTHNAME4 = &H3B
Public Const LOCALE_SMONTHNAME5 = &H3C
Public Const LOCALE_SMONTHNAME6 = &H3D
Public Const LOCALE_SMONTHNAME7 = &H3E
Public Const LOCALE_SMONTHNAME8 = &H3F
Public Const LOCALE_SMONTHNAME9 = &H40
Public Const LOCALE_SMONTHOUSANDSEP = &H17
Public Const LOCALE_SNATIVECTRYNAME = &H8
Public Const LOCALE_SNATIVEDIGITS = &H13
Public Const LOCALE_SNATIVELANGNAME = &H4
Public Const LOCALE_SNEGATIVESIGN = &H51
Public Const LOCALE_SPOSITIVESIGN = &H50
Public Const LOCALE_SSHORTDATE = &H1F
Public Const LOCALE_STHOUSAND = &HF
Public Const LOCALE_STIME = &H1E
Public Const LOCALE_STIMEFORMAT = &H1003
Public Const SDecCurr = "."
Public Const SMieCurr = ","
Public Const DateFormat = "MM/dd/yyyy"
Public Const SeparatorData = "/"
Public Const Sdecimal = "."
Public Const SMie = ","
'Public Db As database
'Public Ws As Workspace
Dim locale As Variant
Dim SeparatorData_Vechi As Variant
Dim DateFormat_Vechi As Variant
Dim SDecimal_Vechi As Variant
Dim Smie_Vechi As Variant
Dim SMieCurr_Vechi As Variant
Dim SDecCurr_Vechi As Variant
Public Function Get_locale() ' Retrieve the regional setting
Dim Symbol As String
Dim iRet1 As Long
Dim iRet2 As Long
Dim lpLCDataVar As String
Dim Pos As Integer
locale = GetUserDefaultLCID()
'*****************************************************************
iRet1 = GetLocaleInfo(locale, LOCALE_SDATE, lpLCDataVar, 0)
Symbol = String$(iRet1, 0)
iRet2 = GetLocaleInfo(locale, LOCALE_SDATE, Symbol, iRet1)
Pos = InStr(Symbol, Chr$(0))
If Pos > 0 Then
Symbol = Left$(Symbol, Pos - 1)
'MsgBox "Regional Setting = " + Symbol
End If
SeparatorData_Vechi = Symbol
'*******************************************************************
iRet1 = GetLocaleInfo(locale, LOCALE_SSHORTDATE, lpLCDataVar, 0)
Symbol = String$(iRet1, 0)
iRet2 = GetLocaleInfo(locale, LOCALE_SSHORTDATE, Symbol, iRet1)
Pos = InStr(Symbol, Chr$(0))
If Pos > 0 Then
Symbol = Left$(Symbol, Pos - 1)
'MsgBox "Regional Setting = " + Symbol
End If
DateFormat_Vechi = Symbol
'********************************************************************
iRet1 = GetLocaleInfo(locale, LOCALE_SDECIMAL, lpLCDataVar, 0)
Symbol = String$(iRet1, 0)
iRet2 = GetLocaleInfo(locale, LOCALE_SDECIMAL, Symbol, iRet1)
Pos = InStr(Symbol, Chr$(0))
If Pos > 0 Then
Symbol = Left$(Symbol, Pos - 1)
'MsgBox "Regional Setting = " + Symbol
End If
SDecimal_Vechi = Symbol
'******************************************************************
iRet1 = GetLocaleInfo(locale, LOCALE_STHOUSAND, lpLCDataVar, 0)
Symbol = String$(iRet1, 0)
iRet2 = GetLocaleInfo(locale, LOCALE_STHOUSAND, Symbol, iRet1)
Pos = InStr(Symbol, Chr$(0))
If Pos > 0 Then
Symbol = Left$(Symbol, Pos - 1)
'MsgBox "Regional Setting = " + Symbol
End If
Smie_Vechi = Symbol
'*****************************************************************
'currency
iRet1 = GetLocaleInfo(locale, LOCALE_SMONTHOUSANDSEP, lpLCDataVar, 0)
Symbol = String$(iRet1, 0)
iRet2 = GetLocaleInfo(locale, LOCALE_SMONTHOUSANDSEP, Symbol, iRet1)
Pos = InStr(Symbol, Chr$(0))
If Pos > 0 Then
Symbol = Left$(Symbol, Pos - 1)
'MsgBox "Regional Setting = " + Symbol
End If
SMieCurr_Vechi = Symbol
iRet1 = GetLocaleInfo(locale, LOCALE_SMONDECIMALSEP, lpLCDataVar, 0)
Symbol = String$(iRet1, 0)
iRet2 = GetLocaleInfo(locale, LOCALE_SMONDECIMALSEP, Symbol, iRet1)
Pos = InStr(Symbol, Chr$(0))
If Pos > 0 Then
Symbol = Left$(Symbol, Pos - 1)
'MsgBox "Regional Setting = " + Symbol
End If
SDecCurr_Vechi = Symbol
End Function
Public Function Set_locale() 'Change the regional setting
Dim iRet As Long
iRet = SetLocaleInfo(locale, LOCALE_SDATE, SeparatorData)
iRet = SetLocaleInfo(locale, LOCALE_SSHORTDATE, DateFormat)
iRet = SetLocaleInfo(locale, LOCALE_SDECIMAL, Sdecimal)
iRet = SetLocaleInfo(locale, LOCALE_STHOUSAND, SMie)
iRet = SetLocaleInfo(locale, LOCALE_SMONTHOUSANDSEP, SMieCurr)
iRet = SetLocaleInfo(locale, LOCALE_SMONDECIMALSEP, SDecCurr)
End Function
Public Function Restore_Locale()
Dim iRet As Long
iRet = SetLocaleInfo(locale, LOCALE_SDATE, SeparatorData_Vechi)
iRet = SetLocaleInfo(locale, LOCALE_SSHORTDATE, DateFormat_Vechi)
iRet = SetLocaleInfo(locale, LOCALE_SDECIMAL, SDecimal_Vechi)
iRet = SetLocaleInfo(locale, LOCALE_STHOUSAND, Smie_Vechi)
iRet = SetLocaleInfo(locale, LOCALE_SMONTHOUSANDSEP, SMieCurr_Vechi)
iRet = SetLocaleInfo(locale, LOCALE_SMONDECIMALSEP, SDecCurr_Vechi)
End Function
--------------------------------------------
On Thu, 10/4/14, him mah <himmah.mlg@gmail.com> wrote:
Subject: [belajar-access] format number (pemisah ribuan) agar tidak terpengaruh regional setting
To: belajar-access@yahoogroups.com
Date: Thursday, 10 April, 2014, 9:22 AM
Assalamu'alaikum Wr. Wb.
selama ini saya masih kesulitan terkait dengan
format number terkait regional setting
format([nilai],"#.##0")
ketika setting regionalnya indonesia hasilnya
adalah 125.000sedangkan kalau regional setting
nya diganti english US maka hasilnya 125,000
yang jadi pertanyaan adalah adakah fungsi agar
pemisah ribuannya itu tetap titik walau regional settingnya
berganti-ganti
kalau pakau input mask sayangnya hasilnya beruma
text bukan number
terima kasih
| Reply via web post | Reply to sender | Reply to group | Start a New Topic | Messages in this topic (2) |
Tidak ada komentar:
Posting Komentar