آموزش vba

[amir1403]

در این تاپیک در مورد برنامه نویسی vba بحث و تبادل نظر می شود.

[amir1403]

سوال : فارسی کردن دکمه های دیالوگ save به وسیله vba چگونه است ؟ آیا کد زیر جواب می دهد؟
Option Explicit


Private Const WH_CBT = 5
Private Const HCBT_DIALOG = 5


Private Type DIALOG_HOOK_PARAMS
hHook As Long
End Type


Private DIALOGHOOK As DIALOG_HOOK_PARAMS


Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long


Public Function SaveFileDialogWithPersianButtons() As String
Dim fd As FileDialog
Dim hwndOwner As Long
Dim hThreadId As Long


Set fd = Application.FileDialog(msoFileDialogSaveAs)
hwndOwner = Application.hWnd
hThreadId = GetCurrentThreadId()


' نصب hook براي تغيير دکمه‌ها
DIALOGHOOK.hHook = SetWindowsHookEx(WH_CBT, AddressOf DialogHookProc, 0, hThreadId)


If fd.Show = -1 Then
SaveFileDialogWithPersianButtons = fd.SelectedItems(1)
Else
SaveFileDialogWithPersianButtons = vbNullString
End If

' حذف hook
UnhookWindowsHookEx DIALOGHOOK.hHook
End Function


Public Function DialogHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = HCBT_DIALOG Then
Dim hwndDialog As Long
hwndDialog = wParam

' تغيير متن دکمه‌ها به فارسي
SetDlgItemText hwndDialog, 1, "ذخيره" ' ID دکمه ذخيره
SetDlgItemText hwndDialog, 2, "لغو" ' ID دکمه لغو


' غير فعال کردن hook
UnhookWindowsHookEx DIALOGHOOK.hHook
End If
DialogHookProc = 0
End Function