Εμφάνιση ενός μόνο μηνύματος
  #2  
Παλιά 11-02-12, 14:39
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.035
Προεπιλογή

Καλημέρα Χρήστο!

Αντικατέστησε τον κώδικα της φόρμας με τον παρακάτω κώδικα:


Κώδικας:
Option Explicit

Private Sub Form_Load()
    ChckShowCur = GetSetting("Acc", "ConvToString", "ShowCurrency", True)
    Me.OptCharCase = GetSetting("Acc", "ConvToString", "OptCharCase", 0)

End Sub

Private Sub ChckShowCur_Click()
    SaveSetting "Acc", "ConvToString", "ShowCurrency", ChckShowCur
End Sub

Private Sub OptCharCase_AfterUpdate()
    SaveSetting "Acc", "ConvToString", "OptCharCase", Nz(Me.OptCharCase, 0)
    Me.Refresh
End Sub

Function NumToWordsWithMoreDecimals(myValue, Optional CharCase%, _
                                    Optional EurosAndCents As Boolean = True) As String
    Dim strTemp As String, strTemp1 As String, tmpValue As String


    If Int(myValue) = myValue Then
        NumToWordsWithMoreDecimals = NumToWords(myValue, CharCase, EurosAndCents)
        Exit Function
    End If
        tmpValue = Mid(myValue - Int(myValue), 3)
        If Len(tmpValue) < 3 Then
            NumToWordsWithMoreDecimals = NumToWords(myValue, CharCase, EurosAndCents)
            Exit Function
        End If
        
        strTemp = NumToWords(Int(myValue), 0, EurosAndCents)
        myValue = Mid(myValue - Int(myValue), 3)

        If myValue = 1 Then
            strTemp1 = " " & ChrW(954) & ChrW(945) & ChrW(953) & " " & _
                       NumToWords(myValue, 0, False) & " " & _
                       ChrW(955) & ChrW(949) & ChrW(960) & ChrW(964) & ChrW(972)

        ElseIf Len(myValue) = 2 Then
            strTemp1 = " " & ChrW(954) & ChrW(945) & ChrW(953) & " " & _
                       NumToWords(myValue, 0, False) _
                     & " " & ChrW(955) & ChrW(949) & ChrW(960) & ChrW(964) & ChrW(940)

        Else

            strTemp1 = " " & ChrW(954) & ChrW(945) & ChrW(953) & " " & NumToWords(myValue, 0, False)

        End If

        strTemp = StrConv(strTemp & strTemp1, vbLowerCase)

        If CharCase = 0 Then
            strTemp = UCase(Left(strTemp, 1)) & Mid(strTemp, 2)
        ElseIf CharCase = 1 Then
            strTemp = UCase(strTemp)
        ElseIf CharCase = 2 Then
            strTemp = StrConv(strTemp, vbProperCase)
        End If
        If CharCase = 1 Or CharCase = 2 Then
            strTemp = Replace(strTemp, ChrW(911), ChrW(937))
            strTemp = Replace(strTemp, ChrW(910), ChrW(933))
            strTemp = Replace(strTemp, ChrW(905), ChrW(919))
            strTemp = Replace(strTemp, ChrW(906), ChrW(921))
            strTemp = Replace(strTemp, ChrW(904), ChrW(917))
            strTemp = Replace(strTemp, ChrW(908), ChrW(927))
            strTemp = Replace(strTemp, ChrW(902), ChrW(913))
            If CharCase = 1 Then strTemp = Replace(strTemp, ChrW(962), ChrW(931))
        End If
        NumToWordsWithMoreDecimals = strTemp
    
End Function
Κατόπιν στο πεδίο της φόρμας "NumberInWords" χρησιμοποίησε τον τύπο:

=IIf([poso] Is Null;Null;NumToWordsWithMoreDecimals([Poso];[OptCharCase];[ChckShowCur]))


Με τις αναγραφόμενες αλλαγές θα μπορούν να μετατρέπονται και αριθμοί που
περιέχουν περισσότερα από 2 δεκαδικά ψηφία.

Καλή συνέχεια!

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών

Τελευταία επεξεργασία από το χρήστη Tasos : 11-02-12 στις 19:01.
Απάντηση με παράθεση