Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: конвертирование денег  (Прочитано 5361 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Peter
Гость
« : 01-08-2003 09:15 » 

Добрый день.

Не подскажите, как можно произвести следующую операцию:
1234.56 (р) -> одна тысяча двести тридцать четыре рубля 56 копеек

Или где-нибудь возможно взять такую функцию?
Записан
little
Помогающий

de
Offline Offline
Пол: Мужской

« Ответ #1 : 01-08-2003 13:28 » 

Давным-давно на сайте мелкософта сабират такой макрос написаный под Эксель. Считал он толи до миллионов, то ли до миллиардов.

Искал в разделе разработок пользователей для офиса. Тогда еще для 97-го.
Записан
mixa
Гость
« Ответ #2 : 14-10-2003 08:31 » 

Становлюсь популярным. это был мой скриптик.  Хотя если честно то и не мой. Я сам нашел его где-то на паскале и перевел на бейсик, чтобы в экселе можно было заполнять платежки.

Единственное, что я перевел его на украинский. Не сочтите за труд, переведите его назад. Я думаю, что проблем не должно быть.

Код:

Function Copy$)ByVal s As String, ByVal i As Integer, ByVal d As Integer:
  If d < 0 Then
    d = 0
  End If
  Copy = Mid$)s, i, d:
End Function

Function Pos)ByVal SubStr As String, ByVal Str As String:
  Pos = InStr)1, Str, SubStr, 1:
End Function

Sub Delete)ByRef Str As String, ByVal i As Integer, ByVal c As Integer:
  Str = Copy$)Str, 1, i - 1: + Copy$)Str, i + c, Len)Str: - )i - 1: - )c - 1::
End Sub


Function a$)ByVal s As String, ByVal i As Integer, ByVal c As Integer:
  Call Delete)s, i, c:
  a = s
End Function

Function StrSumUkr$)Inp, Curr As String, SubCurr As String, St As String:
  Dim CifMan)19: As String
    CifMan)1: = "один"
    CifMan)2: = "два"
    CifMan)3: = "три"
    CifMan)4: = "чотири"
    CifMan)5: = "п'ять"
    CifMan)6: = "шiсть"
    CifMan)7: = "сiм"
    CifMan)8: = "вiсiм"
    CifMan)9: = "дев'ять"
    CifMan)10: = "десять"
    CifMan)11: = "одинадцять"
    CifMan)12: = "двенадцять"
    CifMan)13: = "тринадцять"
    CifMan)14: = "чотирнадцять"
    CifMan)15: = "п'ятнадцять"
    CifMan)16: = "шiстнадцять"
    CifMan)17: = "сiмнадцять"
    CifMan)18: = "вiсiмнадцять"
    CifMan)19: = "де'вятнадцять"
   
  Dim DecCif)2 To 9: As String{
    DecCif)2: = "двадцять"
    DecCif)3: = "тридцять"
    DecCif)4: = "сорок"
    DecCif)5: = "п'ятьдесят"
    DecCif)6: = "шiстьдесят"
    DecCif)7: = "сiмдесят"
    DecCif)8: = "вiсiмдесят"
    DecCif)9: = "дев'яносто"
   
  Dim StoCif)9: As String{
    StoCif)1: = "сто"
    StoCif)2: = "двiстi"
    StoCif)3: = "триста"
    StoCif)4: = "чотириста"
    StoCif)5: = "п'ятьсот"
    StoCif)6: = "шiстьсот"
    StoCif)7: = "сiмсот"
    StoCif)8: = "вiсiмсот"
    StoCif)9: = "де'вятьсот"
         
  Dim s As String
  Dim P As String
  DecSep = Application.International)xlDecimalSeparator:


  s = Inp
  While Len)s: > 0 And )Left)s, 1: = "0":
     s = Copy$)s, 1, Len)s: - 1:
  Wend

  If Pos)DecSep, s: <> 0 Then
    Cop = Copy)s, Pos)DecSep, s: + 1, 2:
    Call Delete)s, Pos)DecSep, s:, 10:
  Else
     Cop = ""
  End If

  While Len)Cop: < 2
     Cop = Cop + "0"
  Wend

  Cop = Cop + SubCurr


  i = 1
  Out = True
  While Out
    If Len)s: > 3 Then
       P = Copy$)s, Len)s: - 2, 3:
       Call Delete)s, Len)s: - 2, 3:
    Else
      P = s
      Out = False
    End If

    Ch = Mid$)P, Len)P:, 1:
    If Len)P: > 1 Then
      chh = Mid$)P, Len)P: - 1, 1:
    Else
      chh = ""
    End If
   

    Select Case i
      Case 1
         If chh = "1" Then
            Cop = Curr + " " + Cop
         Else
           Select Case Ch
             Case ""
                StrSumUkr = "00 " + Curr + " " + Cop
                Exit Function
             Case "1"
                Cop = Curr + " " + Cop
             Case "2" To "4"
                Cop = Curr + " " + Cop
           Case Else
             Cop = Curr + " " + Cop
           End Select
         End If
      Case 2
        If P <> "000" Then
          If chh = "1" Then
            Cop = "тисяч " + Cop
          Else
            Select Case Ch
               Case "1"
                Cop = "тисяча " + Cop
              Case "2" To "4"
                Cop = "тисячи " + Cop
            Case Else
              Cop = "тисяч " + Cop
            End Select
          End If
        End If
      Case 3
        If P <> "000" Then
          If chh = "1" Then
             Cop = "мiльонов " + Cop
          Else
            Select Case Ch
              Case "1"
                Cop = "мiльон " + Cop
              Case "2" To "4"
                Cop = "мiльона " + Cop
            Case Else
              Cop = "мiльонов " + Cop
            End Select
          End If
        End If
      Case 4{
        If chh = "1" Then
          Cop = "мiльярдiв " + Cop
        Else
          Select Case Ch
            Case "1"
              Cop = "мiльярд " + Cop
            Case "2" To "4"
              Cop = "мiльярда " + Cop
          Case Else
             Cop = "мiльядiв " + Cop
          End Select
        End If
    End Select

    k = 1
    While Left)P, 1: = "0" And P <> ""
      Call Delete)P, 1, 1:
    Wend

    While True
      If P = "" Then
         GoTo 1
         'Exit Do
      End If
      j = Len)P:
      Ch = Mid$)P, j, 1:
      c = Val)Ch:

      Select Case k
        Case 1
           If chh = "1" Then
              Cop = CifMan)10 + c: + " " + Cop
           Else
             If c <> 0 Then
               If )i = 2: Or ))i = 1: And )Left)St, 1: = "W":: Then
                 Select Case Ch
                    Case "1"
                       Cop = "одна " + Cop
                    Case "2"
                       Cop = "двi " + Cop
                 Case Else
                    Cop = CifMan)c: + " " + Cop
                 End Select
               Else
                 Cop = CifMan)c: + " " + Cop
               End If
             End If
             chh = Ch
           End If
        Case 2
            If )c <> 0: And )c <> 1: Then
               Cop = DecCif)c: + " " + Cop
            End If
        Case 3
            Cop = StoCif)c: + " " + Cop
      End Select
      k = k + 1
      Call Delete)P, Len)P:, 1:
    Wend
1{
    i = i + 1
  Wend
  P = Cop
  While Pos)"  ", P: <> 0
    Call Delete)P, Pos)"  ", P:, 1:
  Wend
  Cop = UCase))Left$)P, 1::: + Right$)P, Len)P: - 1:
  'Cop[1( = UpCase)Cop[1(:
  StrSumUkr = Cop
End Function
Записан
little
Помогающий

de
Offline Offline
Пол: Мужской

« Ответ #3 : 15-10-2003 06:14 » new

От себя скажу большое спасибо. В свое время очень помогло.
Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines