چگونه بدون تغییر System Locale ، نوشته فارسی در Message Box را به درستی نمایش دهیم؟

[mazoolagh]

1- کد زیر را در یک ماجول کپی کنید:
Public Declare PtrSafe Function MessageBoxW Lib "User32" ( _
ByVal hWnd As LongPtr, _
ByVal lpText As LongPtr, _
ByVal lpCaption As LongPtr, _
ByVal uType As Long _
) As Long


Public Function MsgBoxW( _
Prompt As String, _
Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title As String = "Access" _
) As VbMsgBoxResult

MsgBoxW = MessageBoxW( _
hWnd:=Application.hWndAccessApp, _
lpText:=StrPtr(Prompt), _
lpCaption:=StrPtr(Title), _
uType:=Buttons)
End Function

حالا میتونین از تابع MsgBoxW دقیقا مثل MsgBox استفاده کنین.

2- روش استفاده برای دیتا خوانده شده از دیتابیس:
156401

156402

3- روش استفاده برای دیتا گرفته شده از فرم:
Private Sub BTN_Click()
MsgBoxW _
Prompt:=Me.Text0, _
Buttons:=vbExclamation + vbYesNoCancel + vbMsgBoxRtlReading + vbMsgBoxRight, _
Title:="Test MsgBoxW for form data"
End Sub
156403

[mazoolagh]

ولی همچنان مشکل نمایش نوشته های فارسی که در VBA Editor مینویسین هست.

برای این کار باید یک تابع تبدیل از codepage 1256 به unicode بنویسین،
از نظر فنی کار بسیار راحتی هست ولی کمی باید وقت بذارین.

من جدول تبدیل رو همینجا پیوست میکنم:

ANSI Unicode
=====================
0x00 ; 0x0000 ; #NULL
0x01 ; 0x0001 ; #START OF HEADING
0x02 ; 0x0002 ; #START OF TEXT
0x03 ; 0x0003 ; #END OF TEXT
0x04 ; 0x0004 ; #END OF TRANSMISSION
0x05 ; 0x0005 ; #ENQUIRY
0x06 ; 0x0006 ; #ACKNOWLEDGE
0x07 ; 0x0007 ; #BELL
0x08 ; 0x0008 ; #BACKSPACE
0x09 ; 0x0009 ; #HORIZONTAL TABULATION
0x0A ; 0x000A ; #LINE FEED
0x0B ; 0x000B ; #VERTICAL TABULATION
0x0C ; 0x000C ; #FORM FEED
0x0D ; 0x000D ; #CARRIAGE RETURN
0x0E ; 0x000E ; #SHIFT OUT
0x0F ; 0x000F ; #SHIFT IN
0x10 ; 0x0010 ; #DATA LINK ESCAPE
0x11 ; 0x0011 ; #DEVICE CONTROL ONE
0x12 ; 0x0012 ; #DEVICE CONTROL TWO
0x13 ; 0x0013 ; #DEVICE CONTROL THREE
0x14 ; 0x0014 ; #DEVICE CONTROL FOUR
0x15 ; 0x0015 ; #NEGATIVE ACKNOWLEDGE
0x16 ; 0x0016 ; #SYNCHRONOUS IDLE
0x17 ; 0x0017 ; #END OF TRANSMISSION BLOCK
0x18 ; 0x0018 ; #CANCEL
0x19 ; 0x0019 ; #END OF MEDIUM
0x1A ; 0x001A ; #SUBSTITUTE
0x1B ; 0x001B ; #ESCAPE
0x1C ; 0x001C ; #FILE SEPARATOR
0x1D ; 0x001D ; #GROUP SEPARATOR
0x1E ; 0x001E ; #RECORD SEPARATOR
0x1F ; 0x001F ; #UNIT SEPARATOR
0x20 ; 0x0020 ; #SPACE
0x21 ; 0x0021 ; #EXCLAMATION MARK
0x22 ; 0x0022 ; #QUOTATION MARK
0x23 ; 0x0023 ; #NUMBER SIGN
0x24 ; 0x0024 ; #DOLLAR SIGN
0x25 ; 0x0025 ; #PERCENT SIGN
0x26 ; 0x0026 ; #AMPERSAND
0x27 ; 0x0027 ; #APOSTROPHE
0x28 ; 0x0028 ; #LEFT PARENTHESIS
0x29 ; 0x0029 ; #RIGHT PARENTHESIS
0x2A ; 0x002A ; #ASTERISK
0x2B ; 0x002B ; #PLUS SIGN
0x2C ; 0x002C ; #COMMA
0x2D ; 0x002D ; #HYPHEN-MINUS
0x2E ; 0x002E ; #FULL STOP
0x2F ; 0x002F ; #SOLIDUS
0x30 ; 0x0030 ; #DIGIT ZERO
0x31 ; 0x0031 ; #DIGIT ONE
0x32 ; 0x0032 ; #DIGIT TWO
0x33 ; 0x0033 ; #DIGIT THREE
0x34 ; 0x0034 ; #DIGIT FOUR
0x35 ; 0x0035 ; #DIGIT FIVE
0x36 ; 0x0036 ; #DIGIT SIX
0x37 ; 0x0037 ; #DIGIT SEVEN
0x38 ; 0x0038 ; #DIGIT EIGHT
0x39 ; 0x0039 ; #DIGIT NINE
0x3A ; 0x003A ; #COLON
0x3B ; 0x003B ; #SEMICOLON
0x3C ; 0x003C ; #LESS-THAN SIGN
0x3D ; 0x003D ; #EQUALS SIGN
0x3E ; 0x003E ; #GREATER-THAN SIGN
0x3F ; 0x003F ; #QUESTION MARK
0x40 ; 0x0040 ; #COMMERCIAL AT
0x41 ; 0x0041 ; #LATIN CAPITAL LETTER A
0x42 ; 0x0042 ; #LATIN CAPITAL LETTER B
0x43 ; 0x0043 ; #LATIN CAPITAL LETTER C
0x44 ; 0x0044 ; #LATIN CAPITAL LETTER D
0x45 ; 0x0045 ; #LATIN CAPITAL LETTER E
0x46 ; 0x0046 ; #LATIN CAPITAL LETTER F
0x47 ; 0x0047 ; #LATIN CAPITAL LETTER G
0x48 ; 0x0048 ; #LATIN CAPITAL LETTER H
0x49 ; 0x0049 ; #LATIN CAPITAL LETTER I
0x4A ; 0x004A ; #LATIN CAPITAL LETTER J
0x4B ; 0x004B ; #LATIN CAPITAL LETTER K
0x4C ; 0x004C ; #LATIN CAPITAL LETTER L
0x4D ; 0x004D ; #LATIN CAPITAL LETTER M
0x4E ; 0x004E ; #LATIN CAPITAL LETTER N
0x4F ; 0x004F ; #LATIN CAPITAL LETTER O
0x50 ; 0x0050 ; #LATIN CAPITAL LETTER P
0x51 ; 0x0051 ; #LATIN CAPITAL LETTER Q
0x52 ; 0x0052 ; #LATIN CAPITAL LETTER R
0x53 ; 0x0053 ; #LATIN CAPITAL LETTER S
0x54 ; 0x0054 ; #LATIN CAPITAL LETTER T
0x55 ; 0x0055 ; #LATIN CAPITAL LETTER U
0x56 ; 0x0056 ; #LATIN CAPITAL LETTER V
0x57 ; 0x0057 ; #LATIN CAPITAL LETTER W
0x58 ; 0x0058 ; #LATIN CAPITAL LETTER X
0x59 ; 0x0059 ; #LATIN CAPITAL LETTER Y
0x5A ; 0x005A ; #LATIN CAPITAL LETTER Z
0x5B ; 0x005B ; #LEFT SQUARE BRACKET
0x5C ; 0x005C ; #REVERSE SOLIDUS
0x5D ; 0x005D ; #RIGHT SQUARE BRACKET
0x5E ; 0x005E ; #CIRCUMFLEX ACCENT
0x5F ; 0x005F ; #LOW LINE
0x60 ; 0x0060 ; #GRAVE ACCENT
0x61 ; 0x0061 ; #LATIN SMALL LETTER A
0x62 ; 0x0062 ; #LATIN SMALL LETTER B
0x63 ; 0x0063 ; #LATIN SMALL LETTER C
0x64 ; 0x0064 ; #LATIN SMALL LETTER D
0x65 ; 0x0065 ; #LATIN SMALL LETTER E
0x66 ; 0x0066 ; #LATIN SMALL LETTER F
0x67 ; 0x0067 ; #LATIN SMALL LETTER G
0x68 ; 0x0068 ; #LATIN SMALL LETTER H
0x69 ; 0x0069 ; #LATIN SMALL LETTER I
0x6A ; 0x006A ; #LATIN SMALL LETTER J
0x6B ; 0x006B ; #LATIN SMALL LETTER K
0x6C ; 0x006C ; #LATIN SMALL LETTER L
0x6D ; 0x006D ; #LATIN SMALL LETTER M
0x6E ; 0x006E ; #LATIN SMALL LETTER N
0x6F ; 0x006F ; #LATIN SMALL LETTER O
0x70 ; 0x0070 ; #LATIN SMALL LETTER P
0x71 ; 0x0071 ; #LATIN SMALL LETTER Q
0x72 ; 0x0072 ; #LATIN SMALL LETTER R
0x73 ; 0x0073 ; #LATIN SMALL LETTER S
0x74 ; 0x0074 ; #LATIN SMALL LETTER T
0x75 ; 0x0075 ; #LATIN SMALL LETTER U
0x76 ; 0x0076 ; #LATIN SMALL LETTER V
0x77 ; 0x0077 ; #LATIN SMALL LETTER W
0x78 ; 0x0078 ; #LATIN SMALL LETTER X
0x79 ; 0x0079 ; #LATIN SMALL LETTER Y
0x7A ; 0x007A ; #LATIN SMALL LETTER Z
0x7B ; 0x007B ; #LEFT CURLY BRACKET
0x7C ; 0x007C ; #VERTICAL LINE
0x7D ; 0x007D ; #RIGHT CURLY BRACKET
0x7E ; 0x007E ; #TILDE
0x7F ; 0x007F ; #DELETE
0x80 ; 0x20AC ; #EURO SIGN
0x81 ; 0x067E ; #ARABIC LETTER PEH
0x82 ; 0x201A ; #SINGLE LOW-9 QUOTATION MARK
0x83 ; 0x0192 ; #LATIN SMALL LETTER F WITH HOOK
0x84 ; 0x201E ; #DOUBLE LOW-9 QUOTATION MARK
0x85 ; 0x2026 ; #HORIZONTAL ELLIPSIS
0x86 ; 0x2020 ; #DAGGER
0x87 ; 0x2021 ; #DOUBLE DAGGER
0x88 ; 0x02C6 ; #MODIFIER LETTER CIRCUMFLEX ACCENT
0x89 ; 0x2030 ; #PER MILLE SIGN
0x8A ; 0x0679 ; #ARABIC LETTER TTEH
0x8B ; 0x2039 ; #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
0x8C ; 0x0152 ; #LATIN CAPITAL LIGATURE OE
0x8D ; 0x0686 ; #ARABIC LETTER TCHEH
0x8E ; 0x0698 ; #ARABIC LETTER JEH
0x8F ; 0x0688 ; #ARABIC LETTER DDAL
0x90 ; 0x06AF ; #ARABIC LETTER GAF
0x91 ; 0x2018 ; #LEFT SINGLE QUOTATION MARK
0x92 ; 0x2019 ; #RIGHT SINGLE QUOTATION MARK
0x93 ; 0x201C ; #LEFT DOUBLE QUOTATION MARK
0x94 ; 0x201D ; #RIGHT DOUBLE QUOTATION MARK
0x95 ; 0x2022 ; #BULLET
0x96 ; 0x2013 ; #EN DASH
0x97 ; 0x2014 ; #EM DASH
0x98 ; 0x06A9 ; #ARABIC LETTER KEHEH
0x99 ; 0x2122 ; #TRADE MARK SIGN
0x9A ; 0x0691 ; #ARABIC LETTER RREH
0x9B ; 0x203A ; #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
0x9C ; 0x0153 ; #LATIN SMALL LIGATURE OE
0x9D ; 0x200C ; #ZERO WIDTH NON-JOINER
0x9E ; 0x200D ; #ZERO WIDTH JOINER
0x9F ; 0x06BA ; #ARABIC LETTER NOON GHUNNA
0xA0 ; 0x00A0 ; #NO-BREAK SPACE
0xA1 ; 0x060C ; #ARABIC COMMA
0xA2 ; 0x00A2 ; #CENT SIGN
0xA3 ; 0x00A3 ; #POUND SIGN
0xA4 ; 0x00A4 ; #CURRENCY SIGN
0xA5 ; 0x00A5 ; #YEN SIGN
0xA6 ; 0x00A6 ; #BROKEN BAR
0xA7 ; 0x00A7 ; #SECTION SIGN
0xA8 ; 0x00A8 ; #DIAERESIS
0xA9 ; 0x00A9 ; #COPYRIGHT SIGN
0xAA ; 0x06BE ; #ARABIC LETTER HEH DOACHASHMEE
0xAB ; 0x00AB ; #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
0xAC ; 0x00AC ; #NOT SIGN
0xAD ; 0x00AD ; #SOFT HYPHEN
0xAE ; 0x00AE ; #REGISTERED SIGN
0xAF ; 0x00AF ; #MACRON
0xB0 ; 0x00B0 ; #DEGREE SIGN
0xB1 ; 0x00B1 ; #PLUS-MINUS SIGN
0xB2 ; 0x00B2 ; #SUPERSCRIPT TWO
0xB3 ; 0x00B3 ; #SUPERSCRIPT THREE
0xB4 ; 0x00B4 ; #ACUTE ACCENT
0xB5 ; 0x00B5 ; #MICRO SIGN
0xB6 ; 0x00B6 ; #PILCROW SIGN
0xB7 ; 0x00B7 ; #MIDDLE DOT
0xB8 ; 0x00B8 ; #CEDILLA
0xB9 ; 0x00B9 ; #SUPERSCRIPT ONE
0xBA ; 0x061B ; #ARABIC SEMICOLON
0xBB ; 0x00BB ; #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
0xBC ; 0x00BC ; #VULGAR FRACTION ONE QUARTER
0xBD ; 0x00BD ; #VULGAR FRACTION ONE HALF
0xBE ; 0x00BE ; #VULGAR FRACTION THREE QUARTERS
0xBF ; 0x061F ; #ARABIC QUESTION MARK
0xC0 ; 0x06C1 ; #ARABIC LETTER HEH GOAL
0xC1 ; 0x0621 ; #ARABIC LETTER HAMZA
0xC2 ; 0x0622 ; #ARABIC LETTER ALEF WITH MADDA ABOVE
0xC3 ; 0x0623 ; #ARABIC LETTER ALEF WITH HAMZA ABOVE
0xC4 ; 0x0624 ; #ARABIC LETTER WAW WITH HAMZA ABOVE
0xC5 ; 0x0625 ; #ARABIC LETTER ALEF WITH HAMZA BELOW
0xC6 ; 0x0626 ; #ARABIC LETTER YEH WITH HAMZA ABOVE
0xC7 ; 0x0627 ; #ARABIC LETTER ALEF
0xC8 ; 0x0628 ; #ARABIC LETTER BEH
0xC9 ; 0x0629 ; #ARABIC LETTER TEH MARBUTA
0xCA ; 0x062A ; #ARABIC LETTER TEH
0xCB ; 0x062B ; #ARABIC LETTER THEH
0xCC ; 0x062C ; #ARABIC LETTER JEEM
0xCD ; 0x062D ; #ARABIC LETTER HAH
0xCE ; 0x062E ; #ARABIC LETTER KHAH
0xCF ; 0x062F ; #ARABIC LETTER DAL
0xD0 ; 0x0630 ; #ARABIC LETTER THAL
0xD1 ; 0x0631 ; #ARABIC LETTER REH
0xD2 ; 0x0632 ; #ARABIC LETTER ZAIN
0xD3 ; 0x0633 ; #ARABIC LETTER SEEN
0xD4 ; 0x0634 ; #ARABIC LETTER SHEEN
0xD5 ; 0x0635 ; #ARABIC LETTER SAD
0xD6 ; 0x0636 ; #ARABIC LETTER DAD
0xD7 ; 0x00D7 ; #MULTIPLICATION SIGN
0xD8 ; 0x0637 ; #ARABIC LETTER TAH
0xD9 ; 0x0638 ; #ARABIC LETTER ZAH
0xDA ; 0x0639 ; #ARABIC LETTER AIN
0xDB ; 0x063A ; #ARABIC LETTER GHAIN
0xDC ; 0x0640 ; #ARABIC TATWEEL
0xDD ; 0x0641 ; #ARABIC LETTER FEH
0xDE ; 0x0642 ; #ARABIC LETTER QAF
0xDF ; 0x0643 ; #ARABIC LETTER KAF
0xE0 ; 0x00E0 ; #LATIN SMALL LETTER A WITH GRAVE
0xE1 ; 0x0644 ; #ARABIC LETTER LAM
0xE2 ; 0x00E2 ; #LATIN SMALL LETTER A WITH CIRCUMFLEX
0xE3 ; 0x0645 ; #ARABIC LETTER MEEM
0xE4 ; 0x0646 ; #ARABIC LETTER NOON
0xE5 ; 0x0647 ; #ARABIC LETTER HEH
0xE6 ; 0x0648 ; #ARABIC LETTER WAW
0xE7 ; 0x00E7 ; #LATIN SMALL LETTER C WITH CEDILLA
0xE8 ; 0x00E8 ; #LATIN SMALL LETTER E WITH GRAVE
0xE9 ; 0x00E9 ; #LATIN SMALL LETTER E WITH ACUTE
0xEA ; 0x00EA ; #LATIN SMALL LETTER E WITH CIRCUMFLEX
0xEB ; 0x00EB ; #LATIN SMALL LETTER E WITH DIAERESIS
0xEC ; 0x0649 ; #ARABIC LETTER ALEF MAKSURA
0xED ; 0x064A ; #ARABIC LETTER YEH
0xEE ; 0x00EE ; #LATIN SMALL LETTER I WITH CIRCUMFLEX
0xEF ; 0x00EF ; #LATIN SMALL LETTER I WITH DIAERESIS
0xF0 ; 0x064B ; #ARABIC FATHATAN
0xF1 ; 0x064C ; #ARABIC DAMMATAN
0xF2 ; 0x064D ; #ARABIC KASRATAN
0xF3 ; 0x064E ; #ARABIC FATHA
0xF4 ; 0x00F4 ; #LATIN SMALL LETTER O WITH CIRCUMFLEX
0xF5 ; 0x064F ; #ARABIC DAMMA
0xF6 ; 0x0650 ; #ARABIC KASRA
0xF7 ; 0x00F7 ; #DIVISION SIGN
0xF8 ; 0x0651 ; #ARABIC SHADDA
0xF9 ; 0x00F9 ; #LATIN SMALL LETTER U WITH GRAVE
0xFA ; 0x0652 ; #ARABIC SUKUN
0xFB ; 0x00FB ; #LATIN SMALL LETTER U WITH CIRCUMFLEX
0xFC ; 0x00FC ; #LATIN SMALL LETTER U WITH DIAERESIS
0xFD ; 0x200E ; #LEFT-TO-RIGHT MARK
0xFE ; 0x200F ; #RIGHT-TO-LEFT MARK
0xFF ; 0x06D2 ; #ARABIC LETTER YEH BARREE

[mazoolagh]

این رو میتونین در یک جدول بریزین و با dlookup کردن کد ANSI ، کد معادل یونیکد رو برگیردونین:
156406
یا در array بریزین و از روی ایندکس تبدیل کنین.

[mazoolagh]

حالا یک تابع مینویسین که متن رو کاراکتر به کاراکتر بخونه
و یک string جدید بسازه که تبدیل شده از ansi به یونیکد هست - همین و تمام!

Public Function GetUnicode(ansi As Integer) As Integer
GetUnicode = DLookup("unicode", "chars", "ansi=" & ansi)
End Function


Public Function ToUnicode(ansi_cp1256 As String) As String
Dim B() As Byte
B = ansi_cp1256
Dim i As Integer
Dim tmp As String
Dim uc As Integer
For i = 0 To UBound(B) Step 2
Dim n As Integer
n = B(i + 1) * 256 + B(i)
uc = GetUnicode(n)
tmp = tmp + ChrW(uc)
Next
ToUnicode = tmp
End Function

156407

[atf1379]

با سلام

واقعاً دست مریزاد دارین استاد !
درود بر شما

[ryonis]

ماشالله واقعاً :تشویق::تشویق::تشویق: