صفحه 3 از 3 اولاول 123
نمایش نتایج 81 تا 88 از 88

نام تاپیک: مشکلات فارسی و سورس های مربوطه

  1. #81

    نقل قول: مشکلات فارسی و سورس های مربوطه

    سلام دوستان!
    من یه دیتابیس توی اکسس دارم که اطلاعاتش با "میل مرج Mail merge" به ورود 2013 وارد میشه. مشکلم اینه که حرف "ی" فارسي رو نميشناسه و در Word 2013 اونو به صورت علامت ؟ می نویسه.
    (عکس زیر را ببنید!)
    .
    .
    .

    mailemerge.jpg
    .
    .
    می دونم که با Replace کردن حرف "ي" عربی (با زدن Shift+X) با "ی" فارسی و تغيير تمام "ي" ها در دیتابیس مشکلم به صورت موقتی حل میشه ولی می خواستم بدونم که کسی راه حل اساسی برای حل این مشکل نداره؟ مثلا خاصیت یک فرم رو جوری تغییر بدیم که هر وقت من "ی" فارسی رو تایپ کردم اون به صورت اتوماتیک تبدیلش کنه به "ي" عربی. تو هیچ انجمنی نتونستم جوابی برای این سوال پیدا کنم، امیدوارم شما بتونید منو کمک کنید!

  2. #82

    نقل قول: مشکلات فارسی و سورس های مربوطه

    جواب شما توی پست 49 همین تاپیکه

  3. #83

    Post unstable Font

    با سلام خدمت دوستان ..

    سوال : در ارتباط با unstable بودن یا ثبات نداشتن فونت در فرم ها ست بخصوص Navigation form .

    هر بار که فونتها رو در navigation فرم تغییر میدم بعد از close و open کردن مجدد برنامه فونتها عوض میشن و آن چیزی نیستند که من انتخاب کردم...!!

    چرا؟؟راه کار دوستان برای stable ماندن فونتها چیست ؟؟ ممنون

  4. #84

    نقل قول: مشکلات فارسی و سورس های مربوطه

    با سلام یه راهنمایی کنید من تابع هجری شمسی رو خریداری کردم اگه ممکنه بگید چطوری به صورت اتوماتیک سن دانش آموز رو به سال بگه میلادی مشکلی ندارم ولی با این تابع تو فرم نمی دونم چطوری انجام بدم.

  5. #85

    نقل قول: مشکلات فارسی و سورس های مربوطه

    سلام دوستان
    من میخواستم بدونم چطور می شه تاریخ رو به حروف نوشت البته محدودیت سال1399 را نداشته باشه خیلی ممنون میشم یکی جواب بده
    آخرین ویرایش به وسیله ahmadfm2 : یک شنبه 29 آذر 1394 در 10:37 صبح

  6. #86
    کاربر دائمی
    تاریخ عضویت
    آبان 1384
    محل زندگی
    Tehran
    پست
    112

    Lightbulb نقل قول: مشکلات فارسی و سورس های مربوطه

    به روزرسانی ماژول تبدیل تاریخ شمسی (رفع مشکل 1400 و سال چهار رقمی)


    Option Compare Database

    Public Function Rooz(F_Date As Long) As Integer
    '??? ???? ??? ????? ?? ??? ?? ????? ?? ??????????
    Rooz = F_Date Mod 100
    End Function
    '*******************************************
    Function mah(F_Date As Long) As Integer
    '??? ???? ??? ????? ?? ??? ?? ????? ?? ??????????
    mah = Int((F_Date Mod 10000) / 100)
    End Function
    '*******************************************
    Public Function Sal(F_Date As Long) As Integer
    '??? ???? ??? ????? ?? ??? ?? ????? ?? ??????????
    Sal = Int(F_Date / 10000)
    End Function
    '*******************************************
    Public Function Kabiseh(ByVal OnlySal As Variant) As Integer
    '????? ???? ??? ?????? ???
    '??? ???? ????? ???? ??? ?? ??????????
    '??? ??? ????? ???? ??? ?? ? ????? ??????? ??? ?? ?? ????????
    Kabiseh = 0
    If OnlySal >= 1375 Then
    If (OnlySal - 1375) Mod 4 = 0 Then
    Kabiseh = 1
    Exit Function
    End If
    ElseIf OnlySal <= 1370 Then
    If (1370 - OnlySal) Mod 4 = 0 Then
    Kabiseh = 1
    Exit Function
    End If
    End If

    End Function
    '*******************************************
    Function ValidDate(F_Date As Long) As Boolean
    Dim m, S, R As Integer
    ' ??? ???? ?????? ?? ??? ????? ?? ?? ??? ????? ???? ???? ????? ?? ???
    ' ?? ???? ?????? False ???? ??????? ???? True ??? ????? ????? ????
    ValidDate = True
    S = Sal(F_Date)
    m = mah(F_Date)
    R = Rooz(F_Date)
    '********
    If F_Date < 13100101 Then
    ValidDate = False
    Exit Function
    End If

    If m > 12 Or m = 0 Or R = 0 Then
    ValidDate = False
    Exit Function
    End If

    If R > MahDays(S, m) Then
    ValidDate = False
    Exit Function
    End If
    End Function
    '*******************************************
    Public Function AddDay(ByVal F_Date As Long, ByVal add As Integer) As Long
    Dim K, m, S, R, Days As Integer
    R = Rooz(F_Date)
    m = mah(F_Date)
    S = Sal(F_Date)
    K = Kabiseh(S)

    '????? ??? ?? ??? 1 ??? ????? ??????? ? ?? ????? ??????
    Days = MahDays(S, m)
    If add > Days - R Then
    add = add - (Days - R + 1)
    R = 1
    If m < 12 Then
    m = m + 1
    Else
    m = 1
    S = S + 1
    End If
    Else
    R = R + add
    add = 0
    End If

    While add > 0
    K = Kabiseh(S) '?????: 1 ? ??? ?????: 0
    Days = MahDays(S, m) '????? ?????? ??? ????
    Select Case add
    Case Is < Days
    '??? ????? ?????? ??????? ???? ?? ?? ??? ????
    R = R + add
    add = 0
    Case Days To IIf(K = 0, 365, 366) - 1
    '??? ????? ?????? ??????? ????? ?? ?? ??? ? ???? ?? ?? ??? ????
    add = add - Days
    If m < 12 Then
    m = m + 1
    Else
    S = S + 1
    m = 1
    End If
    Case Else
    '??? ????? ?????? ??????? ????? ?? ?? ??? ????
    S = S + 1
    add = add - IIf(K = 0, 365, 366)
    End Select
    Wend
    AddDay = (S * 10000) + (m * 100) + (R)

    End Function

    '***********************************************
    Public Function shamsi() As Long
    '????? ???? ????? ?? ?? ????? ???? ???? ????? ?? ???
    Dim Shamsi_Mabna As Long
    Dim Miladi_mabna As Date
    Dim Dif As Long
    '?? ????? 80/10/11 ?? 2002/01/01 ????? ???????? ???
    Shamsi_Mabna = 13791012
    Miladi_mabna = #1/1/2001#
    Dif = DateDiff("d", Miladi_mabna, Date)
    If Dif < 0 Then
    MsgBox "????? ???? ????? ??? ?????? ??? , ???? ????? ????."
    Else
    shamsi = AddDay(Shamsi_Mabna, Dif)
    End If
    End Function
    '***********************************************
    Public Function DayWeek(F_Date As Long) As String
    Dim a As String
    Dim N As Integer
    N = DayWeekNo(F_Date)
    Select Case N
    Case 0
    a = "????"
    Case 1
    a = "??????"
    Case 2
    a = "??????"
    Case 3
    a = "???????"
    Case 4
    a = "????????"
    Case 5
    a = "????????"
    Case 6
    a = "????"
    End Select
    DayWeek = a
    End Function

    '***********************************************
    Public Function Dat()
    Dim D As Long
    D = shamsi
    Dat = DayWeek(D) & " " & Sal(D) & "/" & mah(D) & "/" & Rooz(D)
    End Function

    '***********************************************
    Public Function Diff(ByVal FromDate As Long, ByVal To_Date As Long) As Long
    '??? ???? ????? ?????? ??? ?? ????? ?? ????? ?? ???
    Dim Tmp As Long
    Dim s1, m1, r1, s2, m2, r2 As Integer
    Dim Sumation As Single
    Dim Flag As Boolean
    Flag = False
    If FromDate = 0 Or IsNull(FromDate) = True Or To_Date = 0 Or IsNull(To_Date) = True Then
    Diff = 0
    Exit Function
    End If

    If FromDate > To_Date Then
    '??? ????? ???? ?? ????? ????? ?????? ???? ???? ????? ????? ?? ????
    Flag = True
    Tmp = FromDate
    FromDate = To_Date
    To_Date = Tmp
    End If
    r1 = Rooz(FromDate)
    m1 = mah(FromDate)
    s1 = Sal(FromDate)
    r2 = Rooz(To_Date)
    m2 = mah(To_Date)
    s2 = Sal(To_Date)
    Sumation = 0

    Do While s1 < s2 - 1 Or (s1 = s2 - 1 And (m1 < m2 Or (m1 = m2 And r1 <= r2)))
    '??? ?? ??? ?? ????? ?????? ???
    If Kabiseh((s1)) = 1 Then
    If m1 = 12 And r1 = 30 Then
    Sumation = Sumation + 365
    r1 = 29
    Else
    Sumation = Sumation + 366
    End If
    Else
    Sumation = Sumation + 365
    End If
    s1 = s1 + 1
    Loop

    Do While s1 < s2 Or m1 < m2 - 1 Or (m1 = m2 - 1 And r1 < r2)
    '??? ?? ??? ?? ????? ?????? ???
    Select Case m1
    Case 1 To 6
    If m1 = 6 And r1 = 31 Then
    Sumation = Sumation + 30
    r1 = 30
    Else
    Sumation = Sumation + 31
    End If
    m1 = m1 + 1
    Case 7 To 11
    If m1 = 11 And r1 = 30 And Kabiseh(s1) = 0 Then
    Sumation = Sumation + 29
    r1 = 29
    Else
    Sumation = Sumation + 30
    End If
    m1 = m1 + 1
    Case 12
    If Kabiseh(s1) = 1 Then
    Sumation = Sumation + 30
    Else
    Sumation = Sumation + 29
    End If
    s1 = s1 + 1
    m1 = 1
    End Select
    Loop

    If m1 = m2 Then
    Sumation = Sumation + (r2 - r1)
    Else
    Select Case m1
    Case 1 To 6
    Sumation = Sumation + (31 - r1) + r2
    Case 7 To 11
    Sumation = Sumation + (30 - r1) + r2
    Case 12
    If Kabiseh(s1) = 1 Then
    Sumation = Sumation + (30 - r1) + r2
    Else
    Sumation = Sumation + (29 - r1) + r2
    End If
    End Select
    End If

    If Flag = True Then
    Sumation = -Sumation
    End If
    Diff = Sumation
    End Function

    Public Function DayWeekNo(F_Date As Long) As String
    '??? ???? ?? ????? ?? ?????? ???? ? ???? ?? ??? ?? ???? ?? ???? ???
    '??? ???? ???? ??? 0
    '??? 1???? ???? ??? 1
    '......
    '??? ???? ???? ??? 6
    Dim day As String
    Dim Shmsi_Mabna As Long
    Dim Dif As Long
    '???? 80/10/11
    Shmsi_Mabna = 801011
    Dif = Diff(Shmsi_Mabna, F_Date)
    If Shmsi_Mabna > F_Date Then
    Dif = -Dif
    End If
    '?? ???? ?? ????? 80/10/11 3???? ??? ?????? ????? day ?????
    day = (Dif + 3) Mod 7
    If day < 0 Then
    DayWeekNo = day + 7
    Else
    DayWeekNo = day
    End If
    End Function


    Function MahName(ByVal Mah_no As Integer) As String
    Select Case Mah_no
    Case 1
    MahName = "???????"
    Case 2
    MahName = "????????"
    Case 3
    MahName = "?????"
    Case 4
    MahName = "???"
    Case 5
    MahName = "?????"
    Case 6
    MahName = "??????"
    Case 7
    MahName = "???"
    Case 8
    MahName = "????"
    Case 9
    MahName = "???"
    Case 10
    MahName = "??"
    Case 11
    MahName = "????"
    Case 12
    MahName = "?????"
    End Select
    End Function

    Function SalMah(ByVal F_Date As Long) As Integer
    '???? ??? ??? ????? ?? ???? ??? ? ??? ??? ?? ???? ??????
    SalMah = Val(Left$(F_Date, 6))
    End Function

    Function MahDays(ByVal Sal As Integer, ByVal mah As Integer) As Integer
    '??? ???? ????? ?????? ?? ??? ?? ???? ??????
    Select Case mah
    Case 1 To 6
    MahDays = 31
    Case 7 To 11
    MahDays = 30
    Case 12
    If Kabiseh(Sal) = 1 Then
    MahDays = 30
    Else
    MahDays = 29
    End If
    End Select

    End Function

    Function Make_Date(ByVal F_Date As Long) As String
    '?? ????? ?? ????? ?? ???? 10 ???? ?? ??? ???? ??? ???? ??? ????? ?? ???
    Dim D As String
    D = Trim(Str(F_Date))
    If IsNull(F_Date) = True Or F_Date = 0 Then
    Make_Date = ""
    Else
    Make_Date = Mid(D, 1, 4) & "-" & Mid(D, 5, 2) & "-" & Mid(D, 7, 2)
    End If
    End Function

    Function NextMah(ByVal Sal_Mah As Integer) As Integer
    If (Sal_Mah Mod 100) = 12 Then
    NextMah = (Int(Sal_Mah / 100) + 1) * 100 + 1
    Else
    NextMah = Sal_Mah + 1
    End If
    End Function

    Function PreviousMah(ByVal Sal_Mah As Integer) As Integer
    If (Sal_Mah Mod 100) = 1 Then
    PreviousMah = (Int(Sal_Mah / 100) - 1) * 100 + 12
    Else
    PreviousMah = Sal_Mah - 1
    End If
    End Function


    Function SubtractDay(ByVal F_Date As Long, ByVal Subtract As Long) As Long
    '?? ????? ??? ????? ?? ?? ????? ?? ???? ? ????? ????? ?? ????? ?????
    Dim K, m, S, R, Days As Integer

    R = Rooz(F_Date)
    m = mah(F_Date)
    S = Sal(F_Date)
    K = Kabiseh(S)

    '????? ??? ?? ??? 1 ??? ????? ??????? ? ?? ????? ??????
    If Subtract >= R - 1 Then
    Subtract = Subtract - (R - 1)
    R = 1
    Else
    R = R - Subtract
    Subtract = 0
    End If

    While Subtract > 0
    K = Kabiseh(S - 1) '?????: 1 ? ??? ?????: 0
    Days = MahDays(IIf(m >= 2, S, S - 1), IIf(m >= 2, m - 1, 12)) '????? ?????? ??? ????
    Select Case Subtract
    Case Is < Days
    '??? ????? ?????? ???? ???? ?? ?? ??? ????
    R = Days - Subtract + 1
    Subtract = 0
    If m >= 2 Then
    m = m - 1
    Else
    S = S - 1
    m = 12
    End If
    Case Days To IIf(K = 0, 365, 366) - 1
    '??? ????? ?????? ???? ????? ?? ?? ??? ? ???? ?? ?? ??? ????
    Subtract = Subtract - Days
    If m >= 2 Then
    m = m - 1
    Else
    S = S - 1
    m = 12
    End If
    Case Else
    '??? ????? ?????? ???? ????? ?? ?? ??? ????
    S = S - 1
    Subtract = Subtract - IIf(K = 0, 365, 366)
    End Select
    Wend
    SubtractDay = (S * 10000) + (m * 100) + (R)

    End Function

  7. #87

    نقل قول: مشکلات فارسی و سورس های مربوطه

    سلام و ارادت
    ماژول MsgBoxFa مسیج باکس فارسی که در این تاپیک بود را باتوجه به اینکه روی ویندوزهای 64 بیتی عمل نمیکرد اصلاح کردم و در ویندوز 64 و 32 بیتی عمل خواهد کرد

    Option Compare Database
    '----------------------- MsgBoxFa -------------------------
    'https://barnamenevis.org/showthread.php?51987-%D9%85%D8%B4%DA%A9%D9%84%D8%A7%D8%AA-%D9%81%D8%A7%D8%B1%D8%B3%DB%8C-%D9%88-%D8%B3%D9%88%D8%B1%D8%B3-%D9%87%D8%A7%DB%8C-%D9%85%D8%B1%D8%A8%D9%88%D8%B7%D9%87&p=1719291&vie wfull=1#post1719291
    '------------------- مسيج باکس فارسي ----------------------
    ' مناسب سازي شده براي ويندوز 64 و32 بيت '
    ' توسط محسن آل آقا اصلاح شده '
    ' 1400/06/29 '
    ' Hematalea@gmail '
    ' MsgBox براي استفاده از اين ماژول کافيست بجاي نوشتن تابع '
    ' .استفاده کنيد MsgBoxFa از تابع '
    ' '
    ' ------------------------------------------------------- '
    ' Integer را به عنوان MsgBox توجه: اگر در جايي که متغير '
    ' را حذف کنيد Integer ،تعريف کرده ايد '
    ' '
    ' :مثال '
    ' Dim OutPut As Integer <------------ خطا خواهد داد '
    ' OutPut = MsgBoxFa(".... '
    ' '
    ' Dim OutPut <--- بدون خطا اجرا خواهد شد '
    ' OutPut = MsgBoxFa(".... '
    ' '
    '------------------------- Msgbox -------------------------
    Public Const WH_CBT = 5
    Public Const GWL_HINSTANCE = (-6)
    Public Const HCBT_ACTIVATE = 5


    #If VBA7 Then
    Public Type MSGBOX_HOOK_PARAMS
    hWndOwner As LongPtr
    hHook As LongPtr
    End Type


    Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
    Public Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
    Public Declare PtrSafe Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As LongPtr) As LongPtr
    Public Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal lpString As String) As LongPtr
    Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
    Public Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    #Else
    Public Type MSGBOX_HOOK_PARAMS
    hWndOwner As Long
    hHook As Long
    End Type


    Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Public Declare Function GetDesktopWindow Lib "user32" () As Long
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
    Public Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
    Public 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
    Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    #End If


    'need this declared at module level as
    'it is used in the call and the hook proc
    Public MSGHOOK As MSGBOX_HOOK_PARAMS
    #If VBA7 Then
    Public Function MsgBoxFa(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
    Optional Tiltle = "", Optional HelpFile, Optional Context) As LongPtr
    'Wrapper function for the MessageBox API
    Dim hwndThreadOwner As LongPtr
    #Else
    Public Function MsgBoxFa(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
    Optional Tiltle = "", Optional HelpFile, Optional Context) As Long
    Dim hwndThreadOwner As Long
    #End If

    Dim frmCurrentForm As Form
    'On Error Resume Next
    Set frmCurrentForm = Screen.ActiveForm
    hwndThreadOwner = frmCurrentForm.hwnd


    #If VBA7 Then
    Dim hInstance As LongPtr
    Dim hThreadId As LongPtr
    Dim hWndOwner As LongPtr
    #Else
    Dim hInstance As Long
    Dim hThreadId As Long
    Dim hWndOwner As Long
    #End If
    hWndOwner = GetDesktopWindow()
    hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
    hThreadId = GetCurrentThreadId()


    With MSGHOOK
    .hWndOwner = hWndOwner
    .hHook = SetWindowsHookEx(WH_CBT, _
    AddressOf MsgBoxHookProc, _
    hInstance, hThreadId)
    End With

    MsgBoxFa = MessageBox(hwndThreadOwner, Prompt, Tiltle, Buttons)


    End Function
    #If VBA7 Then
    Public Function MsgBoxHookProc(ByVal uMsg As LongPtr, _
    ByVal wParam As LongPtr, _
    ByVal LParam As LongPtr) As LongPtr
    #Else
    Public Function MsgBoxHookProc(ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal LParam As Long) As Long
    #End If
    If uMsg = HCBT_ACTIVATE Then

    SetDlgItemText wParam, vbYes, ChrW(1576) & ChrW(1604) & ChrW(1607) '"بله"
    SetDlgItemText wParam, vbNo, ChrW(1582) & ChrW(1740) & ChrW(1585) ' "خير"
    SetDlgItemText wParam, vbIgnore, ChrW(1604) & ChrW(1594) & ChrW(1608) ' "لغو"
    SetDlgItemText wParam, vbOK, ChrW(1578) & ChrW(1571) & ChrW(1740) & ChrW(1740) & ChrW(1583) ' "تاييد"
    SetDlgItemText wParam, vbCancel, ChrW(1575) & ChrW(1606) & ChrW(1589) & ChrW(1585) & ChrW(1575) & ChrW(1601) ' "انصراف"
    SetDlgItemText wParam, vbAbort, ChrW(1606) & ChrW(1575) & ChrW(1578) & ChrW(1605) & ChrW(1575) & ChrW(1605) & _
    " " & ChrW(1605) & ChrW(1575) & ChrW(1606) & ChrW(1583) & ChrW(1606) ' "ناتمام ماندن"
    SetDlgItemText wParam, vbRetry, ChrW(1578) & ChrW(1604) & ChrW(1575) & ChrW(1588) & _
    " " & ChrW(1583) & ChrW(1608) & ChrW(1576) & ChrW(1575) & ChrW(1585) & ChrW(1607) ' "تلاش دوباره"

    UnhookWindowsHookEx MSGHOOK.hHook

    End If

    MsgBoxHookProc = False


    End Function
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله neshomalea : دوشنبه 29 شهریور 1400 در 15:30 عصر

  8. #88

    نقل قول: مشکلات فارسی و سورس های مربوطه

    ..........

صفحه 3 از 3 اولاول 123

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •