Results 1 to 1 of 1

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Registered User
    Join Date: Oct:2003
    Posts: 1,861

    Öèôðîì â ñëîâîì

    Ïðåäèñòîðèÿòà:
    Èìàì ñè àç åäèí ïðåêðàñåí ìàêðîñ çà ïðåîáðàçóâàíå íà öèôðîì â ñëîâîì, êîéòî ðàáîòåøå (è äîñåãà ñè ðàáîòè) ïðåêðàñíî â Excel 2003/Win7-32, ñëóæè ìè âÿðíî äåñåòèëåòèÿ äà ñè ïèøà ôàêòóðèòå, íî íåùåø ëè ðåøèõ è àç äà ñå ìîäåðíèçèðàì è äà ìèíà íà Office 2016/Win10-64. È çàïî÷íàõà èçíåíàäèòå. Ñòàðèÿ åêñåëñêè ôàéë ñå îòâàðÿ, ñìÿòà ïðàâèëíî, íî ToWords äàâà øàíòàâè ñèìâîëè.
    Åòî ãî ìàêðîñà:
    Code:
    Attribute VB_Name = "Module1"
    ' Êîíâåðòèðàíå íà ÷èñëî â ñëîâîì ñ äóìè çà VBA çà Microsoft Excel
    ' Copyright (c) 2012 Unicontsoft (wqweto@gmail.com)
    '
    ' ÎÏÈÑÀÍÈÅ
    '
    ' Ïî ïîäðàçáèðàíå êîíâåðòèðà ëåâîâå (â ìúæêè ðîä), íî ìîæå äà ñå èçïîëçâà è çà ìÿðêà â æåíñêè ðîä (íàïðèìåð ìåòðî
    ' åäèíèöè) èëè ñðåäåí ðîä (íàïðèìåð åâðî).
    '
    ' ÈÍÑÒÀËÀÖÈß
    '
    ' Ñòàðòèðàéòå VBA â Excel ñ Alt+F11 è ñúñ ùðàêâàíå ñ äåñåí áóòîí íà ìèøêàòà íà VBAProject äîáàâåòå íîâ ïðàçåí
    ' ìîäóë (Module1). Êîïèðàéòå òàçè ôóíêöèÿ (öåëèÿ https://gist.github.com/4118581) â Module1 è çàòâîðåòå VBA
    ' ðåäàêòîðà íà êîä.
    '
    ' ÈÇÏÎËÇÂÀÍÅ
    '
    ' Â êëåòêàòà, â êîÿòî æåëàåòå äà ïèøå ñóìàòà ñëîâîì ìîæåòå äà èçïîëçâàòå òîâà:
    '
    ' = ToWords(123)
    '
    ' èëè äà ïîäàäåòå ñòîéíîñò íà äðóãà êëåòêà (îáùà ñòîéíîñò íà äîêóìåíòà) òàêà
    '
    ' = ToWord(A1)
    '
    ' êîåòî ùå ïðåâúðíå ÷èñëîòî îò A1 â ñëîâîì â òåêóùàòà êëåòêà.
    '
    ' Ìàêñèìàëíà ñòîéíîñò íà ïúðâè ïàðàìåòúð dblValue e 999 êâàäðèëèîíà.
    '
    ' = ToWords(167.42) -> Ñòî øåñòäåñåò è ñåäåì ëâ. è 42 ñò.
    ' = ToWords(-12341235) -> Ìèíóñ äâàíàäåñåò ìèëèîíà òðèñòà ÷åòèðèäåñåò è åäíà õèëÿäè äâåñòà
    ' òðèäåñåò è ïåò ëâ. è 0 ñò.
    ' = ToWords(341.6, "ÌÅ|ñòîòíè", "F") -> Òðèñòà ÷åòèðèäåñåò è åäíà ÌÅ è 60 ñòîòíè
    '
    '=====================================================================================================================
     
    Public Function ToWords(ByVal dblValue As Double, Optional Measure As Variant, Optional Gender As String) As String
    Dim vDigits As Variant
    Dim vGenderDigits As Variant
    Dim vValue As Variant
    Dim lIdx As Long
    Dim lDigit As Long
    '--- init digits (incl. gender ones)
    vDigits = Split("íóëà åäíî äâå òðè ÷åòèðè ïåò øåñò ñåäåì îñåì äåâåò")
    vGenderDigits = vDigits
    Select Case Gender
    Case vbNullString, "M"
    vGenderDigits(1) = "åäèí"
    vGenderDigits(2) = "äâà"
    Case "F"
    vGenderDigits(1) = "åäíà"
    End Select
    '--- split input value on decimal point and pad w/ zeroes
    vValue = Mid$(Format(0, "0.0"), 2, 1)
    vValue = Split(Format(Abs(dblValue), "0.00##"), vValue)
    vValue(0) = Right$(String(18, "0") & vValue(0), 18)
    '--- loop input digits from right to left
    For lIdx = 1 To Len(vValue(0))
    If lIdx <= 3 Then
    lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx + 1, 1)
    Else
    lDigit = Mid$(vValue(0), Len(vValue(0)) - lIdx - 1, 3)
    lIdx = lIdx + 2
    End If
    If lDigit <> 0 Then
    '--- separate by space (first time prepend "è" too)
    If LenB(ToWords) <> 0 And (lIdx <> 2 Or lDigit <> 1) Then
    If InStr(ToWords, " è ") = 0 Then
    ToWords = " è " & ToWords
    Else
    ToWords = " " & ToWords
    End If
    End If
    Select Case lIdx
    Case 1
    ToWords = vGenderDigits(lDigit) & ToWords
    Case 2
    If lDigit = 1 Then
    '--- 11 to 19 special wordforms
    If LenB(ToWords) <> 0 Then
    ToWords = Replace(LTrim$(ToWords), vGenderDigits(1), "åäè")
    ToWords = Replace(ToWords, vGenderDigits(2), "äâà") & "íàäåñåò"
    Else
    ToWords = "äåñåò"
    End If
    Else
    ToWords = IIf(lDigit = 2, "äâà", vDigits(lDigit)) & "äåñåò" & ToWords
    End If
    Case 3
    '--- hundreds have special suffixes for 2 and 3
    Select Case lDigit
    Case 1
    ToWords = "ñòî" & ToWords
    Case 2, 3
    ToWords = vDigits(lDigit) & "ñòà" & ToWords
    Case Else
    ToWords = vDigits(lDigit) & "ñòîòèí" & ToWords
    End Select
    Case 6
    '--- thousands are in feminine gender
    Select Case lDigit
    Case 1
    ToWords = "õèëÿäà" & ToWords
    Case Else
    ToWords = ToWords(lDigit, vbNullString, Gender:="F") & " õèëÿäè" & ToWords
    End Select
    Case 9, 12, 15
    '--- no special cases for bigger values
    ToWords = ToWords(lDigit, vbNullString) & " " & Split("ìèëèîí ìèëèàðä òðèëèîí êâàäðèëèîí")((lIdx - 9) \ 3) _
    & IIf(lDigit <> 1, "à", vbNullString) & ToWords
    End Select
    End If
    Next
    '--- handle zero and negative values
    If LenB(ToWords) = 0 Then
    ToWords = vDigits(0)
    ElseIf dblValue < 0 Then
    ToWords = "ìèíóñ " & ToWords
    End If
    '--- apply measure (use vbNullString for none)
    If IsMissing(Measure) Then
    Measure = "ëâ.|ñò."
    End If
    If LenB(Measure) <> 0 Then
    ToWords = ToWords & " " & Split(Measure, "|")(0) & " è " & Val(vValue(1))
    If InStr(Measure, "|") > 0 Then
    ToWords = ToWords & " " & Split(Measure, "|")(1)
    End If
    ToWords = UCase$(Left$(ToWords, 1)) & Mid$(ToWords, 2)
    End If
    End Function
    Win Locale:Bulgarian - íàâñÿêúäå.
    Êîåòî å èíòåðåñíîòî, ÷å ïðè îïèòà äà îòâîðÿ ìàêðîñà çà ðåäàêòèðàíå âúâ VBA íà Excel 2016/Win10-64 ñå çàñòðåëâà öåëèÿ Excel è ñå ðåñòàðòèðà. Âúâ Win7-32, ìàêðîñà ñå ðåäàêòèðà íîðìàëíî è â 2003 è â 2016 âåðñèè íà Excel. Ïîä Win7-32 â ñòàðèÿ Excel ìàêðîñà ðàáîòè íîðìàëíî, â íîâèÿ - ìàéìóíè. Àç ñúì íàÿñíî, ÷å ñòàðèÿ Excel ðàáîòè ñ ASCII, à íîâèÿ ñ UTF8 (èëè ìîæå áè ñ 1251 - íå çíàì), íî êàæåòå êàê äà ãî ïîäêàðàì äà ðàáîòè â Win10-64 + Excel 2016.

    EDIT: Çà òðèåíå, ñïðàâèõ ñå ñ êîíâåðòèðàíå íà òåêñòà íà ñàìèÿ ìàêðîñ.
    Last edited by Jonata; 7th November 2018 at 15:56.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Copyright © 1999-2011 Õàðäóåð ÁÃ. Âúçìîæíî å ñúäúðæàíèåòî íà òàçè ñòðàíèöà äà å îáåêò íà àâòîðñêè ïðàâà.
iskamPC.com | mobility.BG | Bloody's Techblog | Êðèïòîâàëóòè è ìàéíèíã | 3D Vision Blog | Ìàãàçèí çà åëåêòðîííè öèãàðè