touchiep

Sub W2TH()
'สำหรับแปลงเลขฮินดูอารบิกเป็นเลขไทย
Dim i, s
Dim EngChar
Dim ThaChar
Dim EngArray As Variant
Dim ThaArray As Variant

EngChar = "1 2 3 4 5 6 7 8 9 0"
EngArray = Split(EngChar, " ")

touchiep

Option Explicit

Private Function XLMod(a, b)
    ' This attempts to mimic the Excel MOD function
    XLMod = a - b * Int(a / b)
End Function
Public Function AthikaMas(iYear As Integer) As Boolean
'AthikaMas calculation
'Return True if the specified year is AthikaMas.
'Inspired by Loy's Calculation

touchiep

Function Translate(SText As String, Optional FromLang As String = "0", Optional ToLang As String = "th") As String
    ' Translate text using Google Translate
    Dim p1&, p2&, URL$, resp$, d1$, result
    Dim xmlhttp As New MSXML2.XMLHTTP60 'Must add references (Tools>References) Microsoft XML v 6.0
    
    Const URL_TEMPLATE$ = "https://translate.google.co.th/m?sl=[from]&tl=[to]&hl=[from]&q="
    Const DIV_RESULT$ = "<div class=""result-container"">"
    URL = URL_TEMPLATE & URLEncode(SText)
    URL = Replace(URL, "[to]", ToLang)
    URL = Replace(URL, "[from]", FromLang)

touchiep

Dim LangID
Dim MacroUndo() As Variant
Dim MacroUndo2 As Variant
Public Declare PtrSafe Function InternetGetConnectedState Lib "wininet.dll" ( _
    ByRef lpdwFlags As Long, _
    ByVal dwReserved As Long) _
    As Boolean

Public Function IsInternetOnline() As Boolean
    Dim lConnectionFlag As Long

touchiep

Function Translate(SText As String, Optional FromLang As String = "0", Optional ToLang As String = "th") As String
    ' Translate text using Google Translate
    ' Need References: Microsoft XML 6.0
    Dim p1&, p2&, URL$, resp$, d1$
    Dim xmlhttp As New MSXML2.XMLHTTP60 'Must add references (Tools>References) Microsoft XML v 6.0
    
    Const URL_TEMPLATE$ = "https://translate.google.co.th/m?sl=[from]&tl=[to]&hl=[from]&q="
    Const DIV_RESULT$ = "<div class=""result-container"">"
    URL = URL_TEMPLATE & URLEncode(SText)
    URL = Replace(URL, "[to]", ToLang)

touchiep

Sub ETTranslate()
'Translate current text to Thai by replace original text

Dim msg As Outlook.MailItem
Dim insp As Outlook.Inspector

If Application.ActiveInspector Is Nothing Then
    If Application.ActiveExplorer.Selection.Count = 1 Then
        If Application.ActiveExplorer.Selection.Item(1).Class = olMail Then
            Set msg = Application.ActiveExplorer.Selection.Item(1)

touchiep

Private Declare PtrSafe Function Beep Lib "kernel32" (ByVal soundFrequency As Long, ByVal soundDuration As Long) As Long
  Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For both 32 and 64 Bit Systems

Private Function IsInArray(stringToBeFound As String, arr As Variant) As Long
  Dim i As Long
  ' default return value if value not found in array
  IsInArray = -1

  For i = LBound(arr) To UBound(arr)
    If StrComp(stringToBeFound, arr(i), vbBinaryCompare) = 0 Then

touchiep

Function Phonetics(InputWord As String, Optional EngType As String = "ICAO") As String
'Convert Words to Phonetic Alphabet
'Phonetics version 1.0 by Pongsathorn Sraouthai
'Support English and Thai only
'EngType:
'ICAO = ICAO phonetics alphabet
'animal = animal phonetics alphabet
'fruit = fruit phonetics alphabet
'baby = baby phonetics alphabet
'police = Law Enforcement phonetics alphabet

touchiep

Function EnglishTime(InTime, Optional Formal As Integer = 1)
'Convert Time to English Text
'Formal
'1 = Formal
'2 = Informal
'3 = Military

Dim tInput, ThH, ThM, ThS
Select Case VarType(InTime)
    Case vbDate

touchiep

Public Function ThaiTime(InTime, Optional TimeType As Integer = 1, Optional CType As Integer = 0)
'Version 4.0
'แปลงเลขเวลาเป็นคำอ่าน
'TimeType รองรับได้ 6 แบบ
'1 ระบบ 24 ชั่วโมงแบบราชการ
'2 ระบบ 6 ชั่วโมงแบบ 2490
'3 ระบบ 6 ชั่วโมงแบบสมียใหม่ 2535
'4 ระบบ 24 ชั่วโมงแบบทหาร
'5 ระบบ 8 ยาม แบบอยุธยา 2076
'6 ระบบ 8 ยาม แบบรัตนโกสินทร์ 2443