ddiid

Καλησπέρα έχω κολλήσει στο εξής ,προσπαθώ να φτιάξω στο excel με vba ηλεκτρονική τιμολόγηση .Το έχω ρυθμίσει να μετατρέπει το αριθμητικό ποσό σε ολογράφως ,να το τυπώνει και να το αποθηκεύει σε μορφή excel στον υπολογιστή. Αλλά όταν το τυπώνω δεν εμφανίζει το ολογράφως(#ονομα?) και όταν πηγαίνω να ανοίξω το αποθηκευμένο παρατηρώ ότι δεν κρατάει τη συνάρτηση που το μετατρέπει στο ολογράφως και θα πρέπει να το ξανα ορισω. Υπάρχει τρόπος να το κρατάει και στην αρχική φόρμα και στο αποθηκευμένο αρχειο. Σας επισυνάπτω μέρος του κώδικα. 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 ΣΥΝΑΡΤΗΣΗ ΓΙΑ ΟΛΟΓΡΑΦΩΣ 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(TextNumbe r, " ", "") 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

Ναι όντως το lexmark φαίνεται καλό αλλά δεν γράφει διάρκεια ζωής πόσες σελίδες και δεν ξέρω λατα πόσο υποστηρίζει windows 10. Έχω δεί και εναν konica http://www.skroutz.gr/s/3751968/Konica-Minolta-Bizhub-185.html http://www.refillstation.gr/index.php?route=product/product&product_id=438

Καλησπέρα Ενδιαφέρομαι να αγοράσω ένα μηχάνημα που να σκανάρει στις δυο όψης ,να βγάζει φωτοτυπίες διπλής όψης ,ασπρόμαυρη εκτύπωση, μέγεθος χαρτιού Α4 και μηνιαίες εκτυπώσεις 1000-1500 και τέλος θα χρησιμοποιείται σε δίκτυο μαζί με άλλους υπολογιστές. Θα μπορούσατε να μου προτείνετε 4 επιλογές με κόστος περίπου μέχρι τα 400€ Σας ευχαριστώ

Ειναι το ιδιο αξιοπιστο και το lenovo ?

Μπορείτε να μου πείτε την γνώμη σας ποιο απο τα δύο: lenovo vibe x2 ή lg g2

Γιατί κρασάρι το nba2k15 οταν παω να το ανοίξω? Ποιά άλλα προγράμματα χρειάζονται?

Θέλω να βάλω τα windows 7 64bit, τα cd με τουσ drivers θα είναι αρκετά ή θα πρέπει να τους κατεβάσω απο το internet ,ειδικα για win7 64bit ?

ΜΠΟΡΕΙΤΕ ΝΑ ΜΟΥ ΠΡΟΤΕΙΝΕΤΕ MOTHERBOARD ΜΕ ΤΑ ΧΑΡΑΚΤΗΡΙΣΤΙΚΑ ΑΥΤΗΣ http://www.e-shop.gr/mitriki-asus-b85m-g-retail-p-PER.523153, ΑΛΛΑ ΠΟΙΟ ΚΑΙΝΟΥΡΓΙΑ ΚΑΙ ΠΕΡΙΠΟΥ ΣΤΑ 80 ΕΥΡΩ ?

1) ΝΑ ΒΑΛΩ ΜΙΑ ΡΑΜ 8 GB ή 2x4GB ,ΓΙΑ ΚΑΛΥΤΕΡΗ ΑΠΟΔΟΣΗ ? 2) ΜΠΟΡΕΙΤΕ ΝΑ ΜΟΥ ΠΡΟΤΕΙΝΕΤΕ ΜΙΑ MOTHERBOARD ΚΑΛΥΤΕΡΗ ΑΠΟ http://www.e-shop.gr/mitriki-asus-b85m-g-retail-p-PER.523153ΣΤΑ ΙΔΙΑ ΧΡΗΜΑΤΑ ΠΕΡΙΠΟΥ 77 ΕΥΡΩ

1) ΑΓΟΡΑ ΥΠΟΛΟΓΙΣΤΗ - ΧΡΗΣΗ ΚΥΡΙΩΣ ΝΒΑ2Κ15 ΚΑΙ ΜΕΛΛΟΝΤΙΚΑ ΝΑ ΜΠΟΡΩ ΝΑ ΠΑΙΞΩ ΚΑΠΟΙΑ ΠΑΙΧΝΙΔΙΑ 2) Μπορείτε να μου πείτε αν είναι τα παρακάτω συμβατά μεταξύ τους και αν εχει κάποια άλλη πρόταση στα ιδια χρήματα. ΠΟΙΑ ΚΑΡΤΑ ΓΡΑΦΙΚΩΝ ΑΠΟ ΤΙΣ ΔΥΟ ΚΑΙ ΑΝ ΤΡΟΦΟΔΟΤΙΚΟ ΕΙΝΑΙ ΑΡΚΕΤΟ ΜΠΑΤΖΕΤ 500 ΕΥΡΩ ΓΙΑ ΠΑΙΧΝΙΔΙΑ ΚΑΝΕΝΑ ΠΡΟΓΡΑΜΜΑ ΕΧΩ ΕΙΔΗ ΟΘΟΝΗ 22 ΙΝΤΣΕΣ FULL HD ΔΕΝ ΘΕΛΩ ΠΕΡΙΦΕΡΕΙΑΚΑ ΛΕΩ ΝΑ ΦΤΙΑΞΩ ΑΥΤΟ case: http://www.e-shop.gr/case-supercase-skp-378-p-PER.911048 motherboard: http://www.e-shop.gr/mitriki-asus-b85m-g-retail-p-PER.523153 cpu: http://www.e-shop.gr/cpu-intel-core-i3-4170-370ghz-lga1150-box-p-PER.558490 ram: http://www.e-shop.gr/ram-kingston-hx316c10f-4-4gb-ddr3-1600mhz-hyperx-fury-blue-series-p-PER.550862, 8GB (2x4GB) ssd:http://www.e-shop.gr/ssd-samsung-mz-75e120b-eu-850-evo-series-120gb-25-sata3-p-PER.306097 psu: http://www.e-shop.gr/psu-coolermaster-rs500-acabb1-eu-b2-series-500w-p-PER.813302 gpu: http://www.e-shop.gr/vga-asus-geforce-gt740-gt740-oc-2gd5-2gb-gddr5-pci-e-retail-p-PER.513684 ή http://www.e-shop.gr/vga-asus-gtx750-phoc-1gd5-1gb-gddr5-pci-e-retail-p-PER.513649 ΣΥΝΑΡΜΟΛΟΓΗΣΗ ΑΠΟ ESHOP ΧΩΡΙΣ ΛΕΙΤΟΥΡΓΙΚΟ ΟΧΙ ΑΝΑΒΑΘΜΙΣΗ ΤΑ ΕΠΟΜΕΝΑ 5 ΕΤΗ ΟΧΙ OC ΤΟ CPU ΟΧΙ OC ΤΟ GPU ΟΛΑ ΚΑΙΝΟΥΡΓΙΑ ΚΟΜΜΑΤΙΑ

ΑΓΟΡΑ ΥΠΟΛΟΓΙΣΤΗ ΜΠΟΡΕΙΤΕ ΝΑ ΜΟΥ ΠΕΙΤΕ ΤΗΝ ΑΠΟΨΗ ΣΑΣ ΑΝ ΤΑΙΡΙΑΖΟΥΝ ΜΕΤΑΞΥ ΤΟΥΣ ΚΑΙ ΑΝ ΥΠΑΡΧΕΙ ΚΑΤΙ ΚΑΛΥΤΕΡΟ ΣΤΑ ΙΔΙΑ ΧΡΗΜΑΤΑ. CASE : http://www.e-shop.gr...78-p-PER.911048 MOTHERBOARD : http://www.e-shop.gr...il-p-PER.523153 CPU : http://www.e-shop.gr...ox-p-PER.558490 RAM : http://www.e-shop.gr...es-p-PER.550862, 8GB (2x4GB) SSD : http://www.e-shop.gr...a3-p-PER.306097 PSU : http://www.e-shop.gr...0w-p-PER.813302 GPU : http://www.e-shop.gr...il-p-PER.513684 Ή http://www.e-shop.gr...il-p-PER.513649 ΤΟ ΜΠΑΤΖΕΤ ΕΙΝΑΙ ΠΕΡΙΠΟΥ 500 ΕΥΡΩ

α