[Tasos]

Καλημέρα σε όλους!
Τζίμη, στη λειτουργική μονάδα "ThisWorkBook" Δοκίμασε τον παρακάτω κώδικα:

Option Explicit

Private Sub Workbook_Open()
' Mέθοδος με κουμπί στο μενού "Cell"(Χρειάζεται η αναφορά του Microsoft Office XX.0 Object Library)
    Dim ctl As Office.CommandBarControl
    Set ctl = Application.CommandBars("cell").Controls.Add(1, , , 1, True)
    With ctl
        .FaceId = 1559
        .Caption = "Έλεγχος Α.Φ.Μ."
        .OnAction = ThisWorkbook.CodeName & ".CheckAFM"
    End With
    Application.CommandBars("cell").Controls(2).BeginGroup = True
    
    ' Mέθοδος με συνδυασμό πλήκτρων CTRL + Q (δεν χρειάζεται η αναφορά του Microsoft Office XX.0 Object Library)
    
    ' Application.OnKey "^q", ThisWorkbook.CodeName & ".CheckAFM"
End Sub

Friend Sub CheckAFM()
    Dim a1 As String, c As Range
    Set c = Selection(1)
    a1 = c.Address(False, False)
    If Trim(c) = "" Then Exit Sub
    If Evaluate("=IF(LEN(" & _
            a1 & ")=9,IF(MOD(MOD(SUM(MID(" & _
            a1 & ",9-ROW($1:$8),1)*2^ROW($1:$8)),11),10)=RIGHT(" & _
            a1 & ",1)*1,1,0),0)") Then
        MsgBox "Σωστό Α.Φ.Μ. " & " ( " & a1 & " )", vbInformation
    Else
        MsgBox "Λάθος Α.Φ.Μ. " & " ( " & a1 & " )", vbExclamation
    End If
End Sub

Καλή συνέχεια!

Με εκτίμηση

Τάσος