Results 1 to 1 of 1
Thread: Öèôðîì â ñëîâîì
Hybrid View
-
7th November 2018 14:06 #1Registered User
Join Date: Oct:2003
Posts: 1,861
Öèôðîì â ñëîâîì
Ïðåäèñòîðèÿòà:
Èìàì ñè àç åäèí ïðåêðàñåí ìàêðîñ çà ïðåîáðàçóâàíå íà öèôðîì â ñëîâîì, êîéòî ðàáîòåøå (è äîñåãà ñè ðàáîòè) ïðåêðàñíî â Excel 2003/Win7-32, ñëóæè ìè âÿðíî äåñåòèëåòèÿ äà ñè ïèøà ôàêòóðèòå, íî íåùåø ëè ðåøèõ è àç äà ñå ìîäåðíèçèðàì è äà ìèíà íà Office 2016/Win10-64. È çàïî÷íàõà èçíåíàäèòå. Ñòàðèÿ åêñåëñêè ôàéë ñå îòâàðÿ, ñìÿòà ïðàâèëíî, íî ToWords äàâà øàíòàâè ñèìâîëè.
Åòî ãî ìàêðîñà:
Win Locale:Bulgarian - íàâñÿêúäå.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
Êîåòî å èíòåðåñíîòî, ÷å ïðè îïèòà äà îòâîðÿ ìàêðîñà çà ðåäàêòèðàíå âúâ 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.




Reply With Quote
Ïðåïîðú÷àéòå ìÿñòî çà ïî÷èâêà â...
7th May 2023, 14:24 in Îáùè ïðèêàçêè