Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 08-06-2017, 10:16 AM
DIMI DIMI is offline Does not transfer the words on storage and printing Windows 7 32bit Does not transfer the words on storage and printing Office 2007
Advanced Beginner
Does not transfer the words on storage and printing
 
Join Date: Aug 2017
Posts: 37
DIMI is on a distinguished road
Default Does not transfer the words on storage and printing

Good afternoon,
I am stuck in the following, I try to make excel with vba online invoicing. I have configured to convert the numeric amount into words, to print it and save it in excel format on the computer. But when I print it does not display the word (# name?) And when I go to open the saved I noticed that it does not hold the function that converts it to the letter and I will have to define it again. There is a way to keep it in both the original form and the saved archive. I attach part of the code to you.
Thank you.

Sub NextInvoice()
Range("I5").Value = Range("I5").Value + 1
Range("G26").Value = Range("G34")
Range("G30").Value = Range("G34")
Range("G31").MergeArea.ClearContents
Range("G34").MergeArea.ClearContents
Range("G38").MergeArea.ClearContents
Range("G34").Formula = "=G30-G31"

End Sub



Sub SaveInvWithNewName()
Dim NewFN As Variant
ActiveSheet.Copy
NewFN = "C:\invoice\" & Range("I5").Value & Range("H5").Value & Range("I49").Value & Range("F16").Value & ".xlsm"
ActiveSheet.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbookMacroEnabled


Application.DisplayAlerts = True
ActiveWorkbook.PrintOut copies:=2
ActiveWorkbook.Close SaveChanges:=False
NextInvoice
End Sub
Reply With Quote
  #2  
Old 08-06-2017, 11:57 AM
NoSparks NoSparks is offline Does not transfer the words on storage and printing Windows 7 64bit Does not transfer the words on storage and printing Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

You show no code or function here that will 'convert the numeric amount into words'
Are you using a UDF (user defined function), or calling from code ?
Where is your code and/or function located ?

For better responses you should attach a sample workbook, redacted as necessary.
Reply With Quote
  #3  
Old 08-06-2017, 12:23 PM
DIMI DIMI is offline Does not transfer the words on storage and printing Windows 7 32bit Does not transfer the words on storage and printing Office 2007
Advanced Beginner
Does not transfer the words on storage and printing
 
Join Date: Aug 2017
Posts: 37
DIMI is on a distinguished road
Default

This is the other code I use in the excel file and converts the numeric amount into words, but the code is written in Greek

Code:
Private Const zero As String = "Μηδέν "
Function TextNumber(number As Variant, _
                Optional NegativeText As String = "-", _
                Optional IntGender As Integer = 3, _
                Optional IntMeasurePlural As String, _
                Optional IntMeasureSingular As String, _
                Optional Separator As String = "και", _
                Optional DecCount As Integer = -1, _
                Optional DecGender As Integer = 3, _
                Optional DecMeasurePlural As String, _
                Optional DecMeasureSingular As String, _
                Optional DecNoZero As Boolean = False, _
                Optional IntNoZero As Boolean = False, _
                Optional NoSpace As Boolean = False) As String

Application.Volatile True
If Application.Version < 9 Then GoTo myEnd
If IsDate(number) Then
    TextNumber = DateText(number)
    GoTo myEnd
End If
Select Case True
        Case VBA.IsEmpty(number): GoTo myEnd
        Case Not VBA.IsNumeric(number): TextNumber = CVErr(xlErrValue): GoTo myEnd
        Case Application.IsLogical(number): TextNumber = CVErr(xlErrValue): GoTo myEnd
        Case VBA.IsError(number): TextNumber = CVErr(xlErrValue): GoTo myEnd

End Select
Dim R(0 To 14) As Variant
Dim HD As Variant
Dim Y As Variant
Dim numberDEC As Variant: numberDEC = number
Dim M As Integer
Dim j As Integer
Dim IntPart As String
Dim DecPart As String
Dim dekata As String: dekata = "Δέκατα"
Dim dekato As String: dekato = "Δέκατο"
Dim sta As String: sta = "στά"
Dim sto As String: sto = "στό"

HD = VBA.Array("", "Δέκατα", _
    "Εκατοστά", "Χιλιοστά", _
    "Δεκάκις Χιλιοστά", "Εκατοντάκις Χιλιοστά", _
    "Εκατομμυριοστά", "Δεκάκις Εκατομμυριοστά", _
    "Εκατοντάκις Εκατομμυριοστά", "Δισεκατομμυριοστά", _
    "Δεκάκις Δισεκατομμυριοστά", "Εκατοντάκις Δισεκατομμυριοστά", _
    "Τρισεκατομμυριοστά", "Δεκάκις Τρισεκατομμυριοστά", _
    "Εκατοντάκις Τρισεκατομμυριοστά", "Τετράκις Εκατομμυριοστά")

If Int(Abs(number)) = 1 And IntMeasureSingular <> "" _
        Then IntMeasurePlural = IntMeasureSingular
IntPart = IntText(number, NegativeText, IntGender) & IntMeasurePlural

numberDEC = Abs(numberDEC)
numberDEC = Format(numberDEC, "0.000000000000000")

For j = 14 To 0 Step -1
    R(j) = Mid(numberDEC, Len(numberDEC) - 14 + j, 1)
Next
numberDEC = VBA.Join(R, "")

Select Case True
    Case DecCount = -1 And numberDEC = 0
        DecCount = 0
        DecMeasurePlural = ""
        DecMeasureSingular = ""
Case DecCount = -1 And numberDEC <> 0
        Y = numberDEC
            Do
                Y = Y / 10
                M = M + 1
            Loop While Y = Int(Y)
        DecCount = 15 - M + 1
        DecMeasurePlural = ""
        DecMeasureSingular = ""
        DecGender = 3
End Select
numberDEC = VBA.Left(numberDEC, DecCount)

If numberDEC = 1 And DecMeasureSingular <> "" Then DecMeasurePlural = DecMeasureSingular
Select Case True
    Case DecCount = 0
    Case DecMeasurePlural <> ""
        DecPart = IntText(numberDEC, "", DecGender) & DecMeasurePlural
    Case DecMeasurePlural = ""
        DecPart = IntText(numberDEC, "", DecGender) & HD(DecCount)
            If numberDEC = 1 And DecMeasureSingular = "" Then
                DecPart = Replace(DecPart, dekata, dekato)
                DecPart = Replace(DecPart, sta, sto)
        End If
End Select

Separator = ChrW(32) & Separator & ChrW(32)
If DecCount = 0 Then Separator = ""

If DecNoZero = True Then
If VBA.Left(DecPart, 5) = RTrim(zero) Then Separator = "": DecPart = ""
End If

If IntNoZero = True Then
If IntPart = NegativeText & zero Then Separator = "": IntPart = NegativeText
End If

TextNumber = Application.WorksheetFunction.Trim(IntPart & Separator & DecPart)

If NoSpace = True Then TextNumber = _
Application.WorksheetFunction.Substitute(TextNumber, " ", "")
myEnd:
End Function
Private Function IntText(numberINT As Variant, _
            Optional NegativeText As String = "-", _
            Optional GenderINT As Integer = 3) As String
 Dim Tm As Variant
 Dim Am As Variant
 Dim Fm As Variant
 Dim tt As Variant
 Dim AFt As Variant
 Dim TAFd As Variant
 Dim Te As Variant
 Dim Ae As Variant
 Dim Fe As Variant
Tm = VBA.Array("", "Ένα ", "Δύο ", "Τρία ", "Τέσσερα ", _
    "Πέντε ", "Έξι ", "Επτά ", "Οκτώ ", "Εννέα ")
Am = VBA.Array("", "Ένας ", "Δύο ", "Τρεις ", "Τέσσερις ", _
    "Πέντε ", "Έξι ", "Επτά ", "Οκτώ ", "Εννέα ")
Fm = VBA.Array("", "Μία ", "Δύο ", "Τρεις ", "Τέσσερις ", _
    "Πέντε ", "Έξι ", "Επτά ", "Οκτώ ", "Εννέα ")
tt = VBA.Array("Δέκα ", "Έντεκα ", "Δώδεκα ", "Δεκατρία ", "Δεκατέσσερα ", _
    "Δεκαπέντε ", "Δεκαέξι ", "Δεκαεπτά ", "Δεκαοκτώ ", "Δεκαεννέα ")
AFt = VBA.Array("Δέκα ", "Έντεκα ", "Δώδεκα ", "Δεκατρείς ", "Δεκατέσσερις ", _
    "Δεκαπέντε ", "Δεκαέξι ", "Δεκαεπτά ", "Δεκαοκτώ ", "Δεκαεννέα ")
TAFd = VBA.Array("", "Δέκα ", "Είκοσι ", "Τριάντα ", "Σαράντα ", _
    "Πενήντα ", "Εξήντα ", "Εβδομήντα ", "Ογδόντα ", "Ενενήντα ")
Te = VBA.Array("", "Εκατόν ", "Διακόσια ", "Τριακόσια ", "Τετρακόσια ", _
    "Πεντακόσια ", "Εξακόσια ", "Επτακόσια ", "Οκτακόσια ", "Εννιακόσια ")
Ae = VBA.Array("", "Εκατόν ", "Διακόσιοι ", "Τριακόσιοι ", "Τετρακόσιοι ", _
    "Πεντακόσιοι ", "Εξακόσιοι ", "Επτακόσιοι ", "Οκτακόσιοι ", "Εννιακόσιοι ")
Fe = VBA.Array("", "Εκατόν ", "Διακόσιες ", "Τριακόσιες ", "Τετρακόσιες ", _
    "Πεντακόσιες ", "Εξακόσιες ", "Επτακόσιες ", "Οκτακόσιες ", "Εννιακόσιες ")
Dim ekato As String: ekato = "Εκατό "
Dim ekaton As String: ekaton = "Εκατόν "
Dim Tx As String: Tx = "Χίλια "
Dim Ax As String: Ax = "Χίλιοι "
Dim Fx As String: Fx = "Χίλιες "
Dim xx As String: xx = "Χιλιάδες "
Dim mill As String: mill = "Ένα Εκατομμύριο "
Dim mills As String: mills = "Εκατομμύρια "
Dim billion As String: billion = "Δις "
Dim trillion As String: trillion = "Τρις "
Dim V(0 To 14) As Variant
Dim apart As String, bpart As String, cpart As String
Dim dpart As String, epart As String, totalpart As String
Dim oSgn As Integer, oLen As Integer, i As Integer

oSgn = Sgn(numberINT)
numberINT = Abs(numberINT)
numberINT = Format(numberINT, "0.000000000000000")
numberINT = Int(numberINT)
oLen = Len(numberINT)
If oLen > 15 Then IntText = CVErr(xlErrValue): GoTo myEnd

For i = 0 To oLen - 1
    V(15 - oLen + i) = Mid(numberINT, i + 1, 1)
Next

If V(1) + V(2) = 0 Then Te(1) = ekato
Select Case True
    Case V(0) + V(1) + V(2) = 0
    Case V(1) = 1
        epart = Te(V(0)) & tt(V(2)) & trillion
    Case Else
        epart = Te(V(0)) & TAFd(V(1)) & Tm(V(2)) & trillion
End Select

Te(1) = ekaton
If V(5) + V(4) = 0 Then Te(1) = ekato
Select Case True
    Case V(3) + V(4) + V(5) = 0
    Case V(4) = 1
        dpart = Te(V(3)) & tt(V(5)) & billion
    Case Else
        dpart = Te(V(3)) & TAFd(V(4)) & Tm(V(5)) & billion
End Select

Te(1) = ekaton
If V(7) + V(8) = 0 Then Te(1) = ekato
Select Case True
    Case V(6) + V(7) + V(8) = 0
    Case V(6) + V(7) = 0 And V(8) = 1
        cpart = mill
    Case V(7) = 1
        cpart = Te(V(6)) & tt(V(8)) & mills
    Case Else
        cpart = Te(V(6)) & TAFd(V(7)) & Tm(V(8)) & mills
End Select

If GenderINT = 1 Then Tm = Am: tt = AFt: Te = Ae: Tx = Ax
If GenderINT = 2 Then Tm = Fm: tt = AFt: Te = Fe: Tx = Fx

Te(1) = ekaton
If V(11) + V(10) = 0 Then Fe(1) = ekato
Select Case True
    Case V(9) + V(10) + V(11) = 0
    Case V(9) + V(10) = 0 And V(11) = 1
        bpart = Tx
    Case V(10) = 1
        bpart = Fe(V(9)) & AFt(V(11)) & xx
    Case Else
        bpart = Fe(V(9)) & TAFd(V(10)) & Fm(V(11)) & xx
End Select

Te(1) = ekaton
If V(14) + V(13) = 0 Then Te(1) = ekato
If V(13) = 1 Then apart = Te(V(12)) + tt(V(14)) _
    Else: apart = Te(V(12)) & TAFd(V(13)) & Tm(V(14))

totalpart = epart & dpart & cpart & bpart & apart

If numberINT = 0 Then totalpart = zero
If oSgn = -1 Then NegativeText = NegativeText & " " Else NegativeText = ""

IntText = NegativeText & totalpart
myEnd:
End Function
Private Function DateText(mydate As Variant) As String
Dim oday As Integer: oday = Day(mydate)
Dim omonth As Integer: omonth = Month(mydate)
Dim oyear As Integer: oyear = Year(mydate)
Dim VMONTH As Variant
VMONTH = VBA.Array("", "Ιανουαρίου", "Φεβρουαρίου", "Μαρτίου", _
                    "Απριλίου", "Μαΐου", "Ιουνίου", "Ιουλίου", _
                    "Αυγούστου", "Σεπτεμβρίου", "Οκτωβρίου", _
                    "Νοεμβρίου", "Δεκεμβρίου")
DateText = IntText(oday, "", 2) & VMONTH(omonth) & ", " & IntText(oyear, "", 3)
End Function

Last edited by Pecoflyer; 08-07-2017 at 09:48 AM.
Reply With Quote
  #4  
Old 08-06-2017, 02:44 PM
NoSparks NoSparks is offline Does not transfer the words on storage and printing Windows 7 64bit Does not transfer the words on storage and printing Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

Application.Volatile tells me this is a udf that recalculates every time anything on the sheet gets calculated.

As a udf it is required to be in a General Module. Modules are not copied into new workbooks that are created.

Ok, so what to do about it.... 3 possibilities come to mind

1.) If it's not necessary for things in the saved file to be recalculated, and I doubt it is because you are printing then saving what was printed, save the cell contents as values, that would overwrite the formula in the cell with what's being displayed.

2.) Store the functions on the sheet module and use the WorkSheet_Change event on the specific cells to use the functions to fill in those cells. This would then all be copied with the sheet.

3.) Export the General Module to a file and Import it into the newly created workbook. I believe this requires changing settings in the trust center which is probably best to avoid.
Here's a link you might want to have a look at http://www.cpearson.com/excel/vbe.aspx

Last edited by NoSparks; 08-06-2017 at 02:58 PM. Reason: added link to chip's site
Reply With Quote
  #5  
Old 08-07-2017, 05:36 AM
DIMI DIMI is offline Does not transfer the words on storage and printing Windows 7 32bit Does not transfer the words on storage and printing Office 2007
Advanced Beginner
Does not transfer the words on storage and printing
 
Join Date: Aug 2017
Posts: 37
DIMI is on a distinguished road
Default

Thanks,

could you please give me an example for the first and the second posibility.
Reply With Quote
  #6  
Old 08-07-2017, 06:58 AM
NoSparks NoSparks is offline Does not transfer the words on storage and printing Windows 7 64bit Does not transfer the words on storage and printing Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

Both require knowing what cell(s) you've used the =TextNumber(...) formula in.

#1-- store the value of those cells in variables before copying the sheet to the new workbook then write those values to the same cells in the new workbook before saving. Try something along the lines of this in your original macro
Code:
Sub SaveInvWithNewName()

    Dim NewFN
    Dim variable1
    
With ActiveSheet
    variable1 = .Range("G40").Value
    .Copy
End With

'the newly created sheet automatically becomes the active sheet

With ActiveSheet
    .Range("G40").Value = variable1
End With

'
' rest of your code here
'
End Sub
#2-- much more complex
Reply With Quote
  #7  
Old 08-07-2017, 09:50 AM
Pecoflyer's Avatar
Pecoflyer Pecoflyer is offline Does not transfer the words on storage and printing Windows 7 64bit Does not transfer the words on storage and printing Office 2010 64bit
Expert
 
Join Date: Nov 2011
Location: Brussels Belgium
Posts: 2,943
Pecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond reputePecoflyer has a reputation beyond repute
Default

@Dimi
Hello
to make things more manageable, it's best to wrap code with code tags.
Click "Go advanced " - select the code and click the #button.
I did it for you in post #3 as there were many lines of code
__________________
Using O365 v2503 - Did you know you can thank someone who helped you? Click on the tiny scale in the right upper hand corner of your helper's post
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Self Created OneNote page drops words when printing AR_RonK OneNote 4 03-14-2018 08:12 AM
Does not transfer the words on storage and printing Printing AutoCorrect words list. TDeVore Word 1 01-18-2017 09:06 PM
Does not transfer the words on storage and printing Spaces between words when printing Captain Word 2 06-24-2016 09:10 AM
Outlook Storage dpslusser Outlook 1 08-23-2012 11:48 AM
email storage by job sgk18 Outlook 0 03-26-2012 06:23 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:11 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft