Elegxos AFM se VB gia excel

VB Script και κολπάκια, Excel macro, Word, Powerpoint, κτλ

Συντονιστές: WebDev Moderators, Super-Moderators

Απάντηση
Άβαταρ μέλους
Alice_Cooper
Δημοσιεύσεις: 1947
Εγγραφή: 11 Μάιος 2007 00:33
Τοποθεσία: Ioannina
Επικοινωνία:

Elegxos AFM se VB gia excel

Δημοσίευση από Alice_Cooper » 10 Φεβ 2010 14:59

efiaksa afto gia kati teleftea, epidei oti vrika etoimo gia excel den voithage...
kai eipa na to valo edo na mhn psaxnei kai allos ...

anigoume ton vb editor sto excel (ergalia - makroentolh - vb editor)
epilegoume to fyllo pou theloume kai kanoume c/p ta parakato ....

Κώδικας: Επιλογή όλων

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim test As Boolean
    If Intersect(Target, Range("K8:K3000")) Is Nothing Then
        Exit Sub
    Else
        test = CheckAFM(Target.Value)
        If test = False Then ww = MsgBox("Λανθασμένο Α.Φ.Μ.:" + Target.Value, vbOKOnly)
    End If
End Sub

Function CheckAFM(ByVal afmnum As String) As Boolean
        Dim i As Byte
        Dim sum As Integer
        Dim telef As Integer
        Dim ypol As Integer
        sum = 0
        For i = 1 To 8
        sum = sum + (2 ^ (i)) * Val(Mid(afmnum, 9 - i, 1))
        Next
        ypol = sum Mod 11
    If ypol = 10 Then telef = 0 Else telef = ypol
    If telef <> Val&#40;Right&#40;afmnum, 1&#41;&#41; Then CheckAFM = False Else CheckAFM = True
End Function
to mono pou alazoume einai sthn 3h grammh

Κώδικας: Επιλογή όλων

If Intersect&#40;Target, Range&#40;"K8&#58;K3000"&#41;&#41; Is Nothing Then
pou vazoume to diko mas pedio pou theloume na elegxei

afta, elpizo na voithaei

Edit: alaxtike meta apo protroph tou dva_dev
Edit2: Episis ksexasa na po oti ta kelia prepei na exoun morfopihsh keimenou
Τελευταία επεξεργασία από το μέλος Alice_Cooper την 10 Φεβ 2010 20:32, έχει επεξεργασθεί 2 φορές συνολικά.

Άβαταρ μέλους
dva_dev
Script Master
Δημοσιεύσεις: 3790
Εγγραφή: 16 Σεπ 2005 01:32
Επικοινωνία:

Elegxos AFM se VB gia excel

Δημοσίευση από dva_dev » 10 Φεβ 2010 18:44

Αν κάνεις και το

Κώδικας: Επιλογή όλων

MsgBox&#40;"EaieaoiYii A.O.I.&#58;" + Target.Value, vbOKOnly&#41;
σε κάτι πιο ελληνικό, θα βοηθάει περισσότερο :D

Άβαταρ μέλους
Alice_Cooper
Δημοσιεύσεις: 1947
Εγγραφή: 11 Μάιος 2007 00:33
Τοποθεσία: Ioannina
Επικοινωνία:

Elegxos AFM se VB gia excel

Δημοσίευση από Alice_Cooper » 10 Φεβ 2010 20:29

nai e??? ...
xmmm den to katalavenete etc??? (nomiza oloi mathane "pc/kinezika" me thn microsoft na vgazei 800 code pages :p)...
alaxtike...
ok tora ??? :p
entometaksei to epsaxna san excel vba AFM (h A.F.M.) check digit
xmm malon sto eksoteriko den exoun AFM e??? :p

Άβαταρ μέλους
dva_dev
Script Master
Δημοσιεύσεις: 3790
Εγγραφή: 16 Σεπ 2005 01:32
Επικοινωνία:

Elegxos AFM se VB gia excel

Δημοσίευση από dva_dev » 11 Φεβ 2010 19:17

Αν σε βοηθήσει το λένε vat

Αν πρόκειται να το προχωρήσεις παραπάνω, πες μας αν βρεις κάποιους αλγόριθμους ελέγχου, δες και το http://ec.europa.eu/taxation_customs/vi ... .do#item11

Άβαταρ μέλους
Alice_Cooper
Δημοσιεύσεις: 1947
Εγγραφή: 11 Μάιος 2007 00:33
Τοποθεσία: Ioannina
Επικοινωνία:

Elegxos AFM se VB gia excel

Δημοσίευση από Alice_Cooper » 11 Φεβ 2010 20:59

o algorithmos gia elada einai aftos ....
http://www.digitalnews.gr/έλεγχος-εγκυρότητας-αφμ

evala elegxo gia palia afm h an den exoume afm na prospernaei to check ...
kai alaxa to target.value se target.text giati analoga to pedio xtipage ... tora nomizo ok
an tyxei h skefto kati allo ananeono

Κώδικας: Επιλογή όλων

Private Sub Worksheet_Change&#40;ByVal Target As Range&#41;
     Dim test As Boolean
     If Intersect&#40;Target, Range&#40;"K9&#58;K7999"&#41;&#41; Is Nothing Then
         Exit Sub
     Else
         If Len&#40;Target.Text&#41; = 0 Then Exit Sub
         If Len&#40;Target.Text&#41; <> 9 Then
             ww = MsgBox&#40;"Το Α.Φ.Μ. δεν είναι 9ψήφιο ή λείπει το συμπληρωματικό μηδέν", vbOKOnly&#41;
             Exit Sub
         End If
         test = CheckAFM&#40;Target.Text&#41;
         If test = False Then ww = MsgBox&#40;"Λανθασμένο Α.Φ.Μ.&#58;" + Target.Value, vbOKOnly&#41;
     End If
End Sub
Function CheckAFM&#40;ByVal afmnum As String&#41; As Boolean
         Dim i As Byte
         Dim sum As Integer
         Dim telef As Integer
         Dim ypol As Integer
         sum = 0
         For i = 1 To 8
              sum = sum + &#40;2 ^ &#40;i&#41;&#41; * Val&#40;Mid&#40;afmnum, 9 - i, 1&#41;&#41;
         Next
         ypol = sum Mod 11
    If ypol = 10 Then telef = 0 Else telef = ypol
    If telef <> Val&#40;Right&#40;afmnum, 1&#41;&#41; Then CheckAFM = False Else CheckAFM = True
End Function

Απάντηση

Επιστροφή στο “Office, Excel, Word VB Scripts και Tips”

Μέλη σε σύνδεση

Μέλη σε αυτήν τη Δ. Συζήτηση: Δεν υπάρχουν εγγεγραμμένα μέλη και 0 επισκέπτες