[Tasos]

Καλησπέρα Τζίμη!

Δοκίμασε:

Option Explicit

Private Sub Workbook_Open()
' Mέθοδος με κουμπί στο μενού "Cell"(Χρειάζεται η αναφορά του Microsoft Office XX.0 Object Library)

' Τα κοκκινισμένα ψηφία δηλώνουν τη θέση της εντολής στο μενού.

    Dim ctl As Office.CommandBarControl
    With Application.CommandBars("cell")
        Set ctl = .Controls.Add(1, , , 1, True)
        With ctl
            .FaceId = 1559
            .Caption = "Έλεγχος Α.Φ.Μ."
            .OnAction = ThisWorkbook.CodeName & ".CheckAFM"
            .Parent.Controls(2).BeginGroup = True
        End With

        Set ctl = .Controls.Add(1, , , 2, True)
        With ctl
            .FaceId = 610
            .Caption = "Γ.Γ.Π.Σ"
            .Tag = "http://www.gsis.gr/gsis_site/"
            .OnAction = ThisWorkbook.CodeName & ".GotoURL"
        End With

        Set ctl = .Controls.Add(1, , , 3, True)
        With ctl
            .FaceId = 263
            .Caption = "Excel - Ερωτήσεις / Απαντήσεις"
            .Tag = "http://www.ms-office.gr/forum/excel-erotiseis-apantiseis/"
            .OnAction = ThisWorkbook.CodeName & ".GotoURL"
            .Parent.Controls(2).BeginGroup = True
        End With
    End With
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

Friend Sub GotoURL()
'Αναφορά στη βιβλιοθήκη Microsoft "Shell Controls and Automation" (C:\Windows\System32\shell32.dll)
    Dim strUrl As String
    strUrl = Application.CommandBars.ActionControl.Tag
    Dim oShell As New Shell32.Shell
    oShell.ShellExecute strUrl, "", "", , 1
End Sub