iT邦幫忙

2017 iT 邦幫忙鐵人賽
DAY 10
0
自我挑戰組

Access VBA的眉眉角角系列 第 10 篇

Access VBA 的眉眉角角Day10: 自製多語切換表單

2017鐵人賽
3613 瀏覽

  • 分享至 

  • xImage
    •  

若您開發的程式為多國人員使用，相信一定會有此需求，但Office 2003這個古老的產品，要如何生出多與界面呢？它沒有現代化的開發工具可供快速套用，但我們可以試著使用VBA來解決這個需求，因為只要能控制每個物件的外觀，就能達到使用者界面的多語需求。

我們於需要多語界面的表單上，建立一個名為「Combo_lng」的下拉方塊，並且貼上以下程式：

於該表單的Form_Load加上以下程式碼

Private Sub Form_Load()
    Combo_lng.RowSource = "SELECT DISTINCT A.Lang " & vbCrLf & _
                          "FROM UI_Localization AS A " & vbCrLf & _
                          "WHERE (((A.Form)='" & Me.Name & "')) "
    
    Combo_lng.Value = Config(Me.Name & ".Lang")
    
    If Combo_lng.Value <> "" Then
        combo_lng_AfterUpdate
    End If

End Sub

貼上以下三個Combo_lng用的事件模組

Private Sub combo_lng_AfterUpdate()

    If IsNull(Combo_lng) Then Exit Sub

    Call UIData_Put(Me.Name, Combo_lng)

End Sub

Private Sub Combo_lng_DblClick(Cancel As Integer)
    Dim i As Integer
    Dim bnForceUpdate As Boolean
    
    If IsNull(Combo_lng.Value) Or Len(Combo_lng.Value) = 0 Then Exit Sub
    
    If MsgBox("是否強制更新？如果有新增物件請強制更新！", vbOKCancel) = vbOK Then
        bnForceUpdate = True
    Else
        bnForceUpdate = False
    End If
    
    Call UIData_Get(Me.Name, Combo_lng.Value, bnForceUpdate)
    Combo_lng.Requery
End Sub


Private Sub Combo_lng_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If KeyCode = 13 Then
        
        Dim strSQL As String
        Dim i As Integer
        If MsgBox("是否開啟此語系的資料進行編輯?", vbOKCancel) = vbOK Then
            If ifObjectExists("UI_Localization") = False Then
            
                If MsgBox("資料表不存在，是否建立資料表，並且將" & Combo_lng.text & "語系存入？", vbOKCancel) = vbOK Then
                    Call UIData_Get(Me.Name, Combo_lng.text)
                Else
                    Exit Sub
                End If

            Else
                i = DCount("Lang", "UI_Localization", "Form='" & Me.Name & "' AND Lang='" & Combo_lng.text & "'")
                If i = 0 Then
                    If MsgBox("" & Combo_lng.text & "語系資料不存在，是否要產生?", vbOKCancel) = vbOK Then
                        Call UIData_Get(Me.Name, Combo_lng.text)
                    Else
                        Exit Sub
                    End If
                End If
            End If
            strSQL = "SELECT * FROM UI_Localization WHERE Form='" & Me.Name & "' AND Lang='" & Combo_lng.text & "'"
            Call OpenTempQuery("UI", strSQL, acEdit)
            
        ElseIf MsgBox("是否強制更新" & Combo_lng.text & "介面?", vbOKCancel) = vbOK Then
            Call UIData_Get(Me.Name, Combo_lng.text, True)
            
        ElseIf MsgBox("是否僅帶入" & Combo_lng.text & "語言資料,而不變動位置?", vbOKCancel) = vbOK Then
            Call UIData_Put(Me.Name, Combo_lng.text, True)
            Combo_lng.text = ""
            Combo_lng.Value = ""
            
        End If
        Combo_lng.SetFocus
        Combo_lng.Requery
    End If
End Sub

然後於三個事件重新建立連結，以便之後使用
http://ithelp.ithome.com.tw/upload/images/20161210/20007221EDUXam2p9q.png

以下兩個程式碼請複製到Public模組內，這兩個是用來存取物件狀態的程式

此程式用來讀取各物件的屬性，並將屬性值儲存於資料庫中，並依照使用者的語言類型分類

Function UIData_Get(strFormName As String, strLang As String, Optional bnForceUpdate As Boolean = False)

    If strFormName = "" Or strLang = "" Then Exit Function

    
    
    If ifObjectExists("UI_Localization") = False Then
    
        'http://allenbrowne.com/ser-49.html
        'Access可用欄位類型:TEXT (size),CHAR (size),MEMO,BYTE,SHORT,LONG,SINGLE,DOUBLE,GUID,DECIMAL (precision, scale)
        '                   DATETIME,CURRENCY,COUNTER (seed, increment),YESNO,LONGBINARY,BINARY (size)
        DoCmd.RunSQL "CREATE TABLE UI_Localization " & _
                     "(" & _
                     " [Form] Text(50), " & _
                     " [Lang] Text(3), " & _
                     " [Name] Text(50), " & _
                     " [ControlType] Text(3), " & _
                     " [Value] YESNO, " & _
                     " [Caption] Text(255), " & _
                     " [Left] Text(50), " & _
                     " [Top] Text(50), " & _
                     " [Width] Text(50), " & _
                     " [Height] Text(50), " & _
                     " [Vertial] Text(50), " & _
                     " [FontName] Text(50), " & _
                     " [FontSize] Text(50), " & _
                     " [TextAlign] Text(50), " & _
                     " [ControlTipText] Text(50), " & _
                     " [Disabled] YESNO " & _
                     ")"
    End If

    Dim objCtl As Object
    Dim i As Integer
    Dim m As Object
    Dim strObjCtlValue As String
    
    
    '確認之前是否有該語系資料存在
    i = DCount("Lang", "UI_Localization", "Form='" & strFormName & "' AND Lang='" & strLang & "'")
    
    '若為強制更新,先刪除資料再將i歸零
    If i > 0 And bnForceUpdate = True Then
        If MsgBox("請注意！即將強制更新資料！！語系：" & strLang, vbOKCancel) <> vbOK Then Exit Function
        RunSQL "DELETE * FROM UI_Localization WHERE Form='" & strFormName & "' AND Lang='" & strLang & "'"
        i = 0
    End If
    
    If i > 0 Then
        '有原有資料的話, 更新資料
        If MsgBox("請注意！即將覆蓋資料！！語系：" & strLang, vbOKCancel) <> vbOK Then Exit Function
        
        '依照ControlType特性更新資料
        For Each objCtl In Forms(strFormName).Controls
            If objCtl.ControlType = 100 Then 'Label
                Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization WHERE Name ='" & objCtl.Name & "' AND Form = '" & strFormName & "' AND Lang='" & strLang & "' AND Disabled = False")
                If m.EOF = False Then
                    m.Edit
                    m("Left") = objCtl.Left
                    m("Top") = objCtl.Top
                    m("Width") = objCtl.Width
                    m("Height") = objCtl.Height
                    m("FontName") = objCtl.FontName
                    m("FontSize") = objCtl.FontSize
                    m("TextAlign") = objCtl.TextAlign 'v
                    m("Caption") = objCtl.Caption
                    m("ControlTipText") = objCtl.ControlTipText
                    m("ControlType") = objCtl.ControlType
                    m.Update
                End If
            ElseIf objCtl.ControlType = 104 Then  'Command
                Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization WHERE Name ='" & objCtl.Name & "' AND Form = '" & strFormName & "' AND Lang='" & strLang & "' AND Disabled = False")
                If m.EOF = False Then
                    m.Edit
                    m("Left") = objCtl.Left
                    m("Top") = objCtl.Top
                    m("Width") = objCtl.Width
                    m("Height") = objCtl.Height
                    m("FontName") = objCtl.FontName
                    m("FontSize") = objCtl.FontSize
                    m("Caption") = objCtl.Caption
                    m("ControlTipText") = objCtl.ControlTipText
                    m("ControlType") = objCtl.ControlType
                    m.Update
                End If
            ElseIf objCtl.ControlType = 122 Then  'Toggle
                If IsNull(objCtl.Value) Then
                    strObjCtlValue = False
                Else
                    strObjCtlValue = objCtl.Value
                End If
            
                Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization WHERE Name ='" & objCtl.Name & "' AND Form = '" & strFormName & "' AND Lang='" & strLang & "' AND Value=" & strObjCtlValue & " AND Disabled = False")
                If m.EOF = False Then
                    m.Edit
                    m("Left") = objCtl.Left
                    m("Top") = objCtl.Top
                    m("Width") = objCtl.Width
                    m("Height") = objCtl.Height
                    m("FontName") = objCtl.FontName
                    m("FontSize") = objCtl.FontSize
                    m("Caption") = objCtl.Caption
                    m("ControlTipText") = objCtl.ControlTipText
                    m("ControlType") = objCtl.ControlType
                    m.Update
                End If
            End If
        Next objCtl
    
    Else
        '沒有的話,寫入資料
        For Each objCtl In Forms(strFormName).Controls
            
            '依照ControlType特性寫入
            If objCtl.ControlType = 100 Then   'Label
                Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization ")
                m.AddNew
                m("Name") = objCtl.Name
                m("Form") = strFormName
                m("Lang") = strLang
                m("Disabled") = False
                m("Left") = objCtl.Left
                m("Top") = objCtl.Top
                m("Width") = objCtl.Width
                m("Height") = objCtl.Height
                m("FontName") = objCtl.FontName
                m("FontSize") = objCtl.FontSize
                m("TextAlign") = objCtl.TextAlign 'v
                m("Caption") = objCtl.Caption
                m("ControlTipText") = objCtl.ControlTipText
                m("ControlType") = objCtl.ControlType
                m.Update
            ElseIf objCtl.ControlType = 104 Then  'Command
                Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization ")
                m.AddNew
                m("Name") = objCtl.Name
                m("Form") = strFormName
                m("Lang") = strLang
                m("Disabled") = False
                m("Left") = objCtl.Left
                m("Top") = objCtl.Top
                m("Width") = objCtl.Width
                m("Height") = objCtl.Height
                m("FontName") = objCtl.FontName
                m("FontSize") = objCtl.FontSize
                m("Caption") = objCtl.Caption
                m("ControlTipText") = objCtl.ControlTipText
                m("ControlType") = objCtl.ControlType
                m.Update
    
            ElseIf objCtl.ControlType = 122 Then  'Toggle
                If IsNull(objCtl.Value) Then
                    strObjCtlValue = False
                Else
                    strObjCtlValue = objCtl.Value
                End If
                
                Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization ")
                m.AddNew
                m("Name") = objCtl.Name
                m("Form") = strFormName
                m("Lang") = strLang
                m("Value") = strObjCtlValue
                m("Disabled") = False
                m("Left") = objCtl.Left
                m("Top") = objCtl.Top
                m("Width") = objCtl.Width
                m("Height") = objCtl.Height
                m("FontName") = objCtl.FontName
                m("FontSize") = objCtl.FontSize
                m("Caption") = objCtl.Caption
                m("ControlTipText") = objCtl.ControlTipText
                m("ControlType") = objCtl.ControlType
                m.Update
            ElseIf objCtl.ControlType = 124 Then  'Toggle
                
                Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization ")
                m.AddNew
                m("Name") = objCtl.Name
                m("Form") = strFormName
                m("Lang") = strLang
                m("Value") = strObjCtlValue
                m("Disabled") = False
                m("Left") = objCtl.Left
                m("Top") = objCtl.Top
                m("Width") = objCtl.Width
                m("Height") = objCtl.Height
                m("Caption") = objCtl.Caption
                m("ControlTipText") = objCtl.ControlTipText
                m("ControlType") = objCtl.ControlType
                m.Update
            Else
                Debug.Print objCtl.ControlType & " " & objCtl.Name
            
            End If
        Next objCtl
    
    End If
        

MsgBox "完成!"

End Function

將物件設定由資料庫取出，放到物件上使用：

Function UIData_Put(strFormName As String, strLang As String, Optional bnOnlyLang As Boolean = False)
    Dim m As Object
    Dim strName As String
    
    If strLang = "" Then Exit Function
    
    If ifObjectExists("UI_Localization") = False Then Exit Function
    
        
    Dim objCtl As Object
    
    '確認是否有該語言存在
    Set m = CurrentDb.OpenRecordset("SELECT * FROM UI_Localization WHERE Form = '" & strFormName & "' AND Lang='" & strLang & "' And Disabled = False")
    If m.EOF = True Then
        MsgBox "無此語言資料！"
        Exit Function
    End If
    
    strName = m("Name")
    
    '有的話將找出的資料寫入Form中
    Do
        If m("ControlType") = 100 Then
            Set objCtl = Forms(strFormName).Controls(m("Name"))
            If bnOnlyLang = False Then
                objCtl.Left = m("Left")
                objCtl.Top = m("Top")
                objCtl.Width = m("Width")
                objCtl.Height = m("Height")
            End If
            objCtl.FontName = m("FontName")
            objCtl.FontSize = m("FontSize")
            objCtl.TextAlign = m("TextAlign")
            If IsNull(m("Caption")) = False Then objCtl.Caption = m("Caption")
            If IsNull(m("ControlTipText")) = False Then objCtl.ControlTipText = m("ControlTipText")
            
        ElseIf m("ControlType") = 104 Then
            Set objCtl = Forms(strFormName).Controls(m("Name"))
            If bnOnlyLang = False Then
                objCtl.Left = m("Left")
                objCtl.Top = m("Top")
                objCtl.Width = m("Width")
                objCtl.Height = m("Height")
            End If
            objCtl.FontName = m("FontName")
            objCtl.FontSize = m("FontSize")
            If IsNull(m("Caption")) = False Then objCtl.Caption = m("Caption")
            If IsNull(m("ControlTipText")) = False Then objCtl.ControlTipText = m("ControlTipText")
        
        ElseIf m("ControlType") = 122 Then
            Set objCtl = Forms(strFormName).Controls(m("Name"))
            If bnOnlyLang = False Then
                objCtl.Left = m("Left")
                objCtl.Top = m("Top")
                objCtl.Width = m("Width")
                objCtl.Height = m("Height")
            End If
            objCtl.FontName = m("FontName")
            objCtl.FontSize = m("FontSize")
            
            If objCtl.Value = m("Value") Or IsNull(objCtl.Value) Then
                If IsNull(m("Caption")) = False Then objCtl.Caption = m("Caption")
                If IsNull(m("ControlTipText")) = False Then objCtl.ControlTipText = m("ControlTipText")
            End If
        
        ElseIf m("ControlType") = 124 Then
            Set objCtl = Forms(strFormName).Controls(m("Name"))
            If bnOnlyLang = False Then
                objCtl.Left = m("Left")
                objCtl.Top = m("Top")
                objCtl.Width = m("Width")
                objCtl.Height = m("Height")
            End If
            
            If IsNull(m("Caption")) = False Then objCtl.Caption = m("Caption")
            If IsNull(m("ControlTipText")) = False Then objCtl.ControlTipText = m("ControlTipText")
        
        End If
        
        m.MoveNext
    Loop Until m.EOF = True

    Call ConfigSave(strFormName & ".Lang", strLang)
    
End Function

我們這裡建立一個名為「F_Day10」的表單進行示範，裡面塞了Access的各式物件
http://ithelp.ithome.com.tw/upload/images/20161210/200072214BqSV1JGTD.png

我們於新增的「Combo_lng」下拉方塊物件上手動輸入三碼語言碼，我的資料表設計為僅儲存三碼當作語言分類，如果需要更多碼的，可以再自行調整，三碼輸入完後，按下Enter
http://ithelp.ithome.com.tw/upload/images/20161210/20007221l8GKeY4YZr.png

之後會出現「是否開啟此語系的資料進行編輯?」，我們這裡選擇是
http://ithelp.ithome.com.tw/upload/images/20161210/200072217R4LcUXi6r.png

如果初次使用，將會詢問是否建立資料表，並儲存語系資料，這裡選擇是
http://ithelp.ithome.com.tw/upload/images/20161210/20007221uiG8w2iyps.png

完成視窗，按下確定
http://ithelp.ithome.com.tw/upload/images/20161210/200072210AOGhX4ViH.png

隨後會帶出剛剛建立的該語言物件清單，這裡我們由於是建立CHT(繁體)，所以這裡就暫時不改
http://ithelp.ithome.com.tw/upload/images/20161210/200072210A1caMrEr0.png

將資料表關閉後，可以由下拉選單看到CHT的語言可選
http://ithelp.ithome.com.tw/upload/images/20161210/20007221sExRJDfv9X.png

我們再依照上面的順序，建立ENG英文語言
http://ithelp.ithome.com.tw/upload/images/20161210/20007221xvSeTO0l0h.png

最後開啟ENG語言清單，我們將Caption的部份進行修改
http://ithelp.ithome.com.tw/upload/images/20161210/20007221ZznxwJe6lt.png

然後語言的部份下拉到ENG並選擇
http://ithelp.ithome.com.tw/upload/images/20161210/20007221nm6seyPMWw.png

接下來就會看到，修改的部份都顯示出來了，但「子表單」的部份就沒有改到了
http://ithelp.ithome.com.tw/upload/images/20161210/20007221gIaC68iEpH.png

修改語言的部份，有個很大的問題是，不同語言的空間使用有所不同，所以會需要再調整物件的位置與大小，但是該如何調整？有幾個步驟需要處理，首先要把語言內容翻譯完成，這樣才能知道佔用的空間差異，若還沒修改好，可點選「Combo_lng」物件輸入文字的部份，然後按下Enter，即可依照之前步驟修改翻譯內容。
待完成後，我們要接著修改物件位置與大小，這時候各位會想到，那就轉到「設計模式」即可，但沒這麼簡單，如果直接轉設計模式
http://ithelp.ithome.com.tw/upload/images/20161210/20007221lENISMaL5B.png

你會發現各物件的Caption都還停留在未更改的狀態
http://ithelp.ithome.com.tw/upload/images/20161210/20007221FAVogpNFHr.png

我們再切到檢視畫面
http://ithelp.ithome.com.tw/upload/images/20161210/20007221tViT9giKJQ.png

於檢視畫面中的任何物件上按下滑鼠右鍵->屬性
http://ithelp.ithome.com.tw/upload/images/20161210/20007221WpsYnNgojw.png

修改任何屬性的內容，然後再改回原始值
http://ithelp.ithome.com.tw/upload/images/20161210/20007221pojuZNe5hH.png

然後回到表單畫面，按下「存檔」
http://ithelp.ithome.com.tw/upload/images/20161210/20007221kyceaBhhyR.png

儲存完畢後，再切到「設計檢視」即可看到以改為英文狀態
http://ithelp.ithome.com.tw/upload/images/20161210/20007221fNvscnGFSs.png

然後我們再依照自己的需求，修改字型大小、字體，調整位置，然後存檔，關閉此表單
http://ithelp.ithome.com.tw/upload/images/20161210/20007221Rfee3zQrnT.png

然後切到資料表上，會看到已建立了「UI_Localization」資料表，但我們不是要開這個，而是開「Config」
http://ithelp.ithome.com.tw/upload/images/20161210/20007221MoXonp2ZAS.png

我們將 F_Day10.Lang的資料刪除掉(Delete)
http://ithelp.ithome.com.tw/upload/images/20161210/20007221SsJwxa03bx.png

按是進行刪除
http://ithelp.ithome.com.tw/upload/images/20161210/20007221RzxjCrMQtm.png

這裡是為了讓開啟表單時，不要執行載入上一個選擇的語言設定，進行刪除後，找不到上一筆語言設定即可
http://ithelp.ithome.com.tw/upload/images/20161210/20007221iBv8fnvBAM.png

然後我們手動輸入ENG然後按Enter
http://ithelp.ithome.com.tw/upload/images/20161210/20007221vv732Xame8.png

編輯選擇取消
http://ithelp.ithome.com.tw/upload/images/20161210/20007221FSaveHF1rS.png

強制更新，選擇確定
http://ithelp.ithome.com.tw/upload/images/20161210/20007221KST9us7jQG.png

按確定後更新
http://ithelp.ithome.com.tw/upload/images/20161210/20007221dAqJsKP6r4.png

完成後按確定
http://ithelp.ithome.com.tw/upload/images/20161210/20007221BigAuERSSB.png

然後語言下拉選單切換，就可以看到效果
http://ithelp.ithome.com.tw/upload/images/20161210/20007221oNzgpHdWO2.png

但由於我的程式沒有針對Font Color(字體顏色)與Font Bold(粗體字)的設定進行存取，因此切回CHT時，這兩個屬性還是留著
http://ithelp.ithome.com.tw/upload/images/20161210/20007221XJYVymWHiv.png

以上程式與資料表設定並非完美，僅為個人開發使用，若有需求者，可以再依照自己的需求加以改善。今日的分享，希望各位喜歡！


上一篇
Access VBA 的眉眉角角Day9: 關於日期挑選這檔事
下一篇
Access VBA 的眉眉角角Day11: 資料夾與檔案的處理
系列文
Access VBA的眉眉角角 共 30 篇
  1. 26
    Access VBA 的眉眉角角Day26: Windows認證與Active Directory認證
  2. 27
    Access VBA 的眉眉角角Day27: 連結外部Access檔案
  3. 28
    Access VBA 的眉眉角角Day28: 連結外部ODBC資料表
  4. 29
    Access VBA 的眉眉角角Day29: 物件的存取
  5. 30
    Access VBA 的眉眉角角Day30: MDB檔案備份
完整目錄
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

尚未有邦友留言

立即登入留言
iThome鐵人賽
參賽組數
1123 組
團體組數
52 組
累計文章數
23096 篇
完賽人數
656 人
iT+看影片追技術 看影片追技術 看更多
熱門tag 看更多
15th鐵人賽 13th鐵人賽 14th鐵人賽 12th鐵人賽 11th鐵人賽 鐵人賽 2019鐵人賽 2018鐵人賽 javascript 2017鐵人賽 python windows php c# windows server linux css 程式設計 react vue.js
熱門問題
熱門回答
熱門文章
IT邦幫忙