Help for add a short cut keyboard to my add-in

S

supercrs

Hello,

Hello, I have to develop a component add-in for Excel in VB6.
my code *
Option Explicit
Dim oPic As IPictureDisp
Dim oMask As IPictureDisp
Dim oXL As Object
Dim xlApp As Excel.Application
Dim WithEvents MyButton As Office.CommandBarButton

Private Sub AddinInstance_OnConnection(ByVal Application As Object
_
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
Set oXL = Application
Set MyButton = oXL.CommandBars("Standard").Controls.Add(1)






If xlApp.Version = "9.0" Then
With MyButton
.Style = msoButtonCaption
.ToolTipText = "Génération de code barre"
.Caption = "Ean13"
.Visible = True
.Tag = "Gen BarCode"
.OnAction = "!<" & AddInInst.ProgId & ">"
End With
Else
Set oPic = LoadPicture(App.Path & "\genCode2.bmp")
Set oMask = LoadPicture(App.Path & "\genCode2.bmp")
With MyButton
.Picture = oPic
.Mask = oMask
.ToolTipText = "Génération de code barre"
.Visible = True
.Tag = "Gen BarCode"
.OnAction = "!<" & AddInInst.ProgId & ">"

End With
End If
End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
On Error Resume Next

MyButton.Delete
Set MyButton = Nothing
Set oXL = Nothing
End Sub

Private Sub MyButton_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
GenCode
End Sub

Sub GenCode()
Dim chaine As String
Dim i%, checksum%, first%, CodeBarre$, tableA As Boolean

chaine = oXL.Selection.Formula
If Len(chaine) = 12 Or Len(chaine) = 13 Then
For i = 1 To 12
If Asc(Mid$(chaine, i, 1)) < 48 Or Asc(Mid$(chaine, i, 1)
i = 0
Exit For
End If
Next
If i = 13 Then
For i = 2 To 12 Step 2
checksum% = checksum% + Val(Mid$(chaine, i, 1))
Next
checksum = checksum * 3
For i = 1 To 11 Step 2
checksum = checksum + Val(Mid$(chaine, i, 1))
Next
chaine = chaine & (10 - checksum Mod 10) Mod 10
CodeBarre = Left$(chaine, 1) & Chr$(65 + Val(Mid$(chaine
2, 1)))
first = Val(Left$(chaine, 1))
For i = 3 To 7
tableA = False
Select Case i
Case 3
Select Case first
Case 0 To 3
tableA = True
End Select
Case 4
Select Case first
Case 0, 4, 7, 8
tableA = True
End Select
Case 5
Select Case first
Case 0, 1, 4, 5, 9
tableA = True
End Select
Case 6
Select Case first
Case 0, 2, 5, 6, 7
tableA = True
End Select
Case 7
Select Case first
Case 0, 3, 6, 8, 9
tableA = True
End Select
End Select
If tableA Then
CodeBarre = CodeBarre & Chr(65 + Val(Mid$(chaine
i, 1)))
Else
CodeBarre = CodeBarre & Chr(75 + Val(Mid$(chaine
i, 1)))
End If
Next
CodeBarre = CodeBarre & "*"
For i = 8 To 13
CodeBarre = CodeBarre & Chr(97 + Val(Mid$(chaine, i
1)))
Next
CodeBarre = CodeBarre & "+"
End If
oXL.Selection.Formula = CodeBarre
oXL.Selection.Font.Size = 30
oXL.Selection.Font.Name = "Code EAN13"
Else
MsgBox "Le Gencode sélectionner n'est pas valide "

End If

End Sub*


I will want to add a short cut keyboard (Ctrl+shift+s) has my add-in
But I do not find how to make.
Thank you for your assistance

CR
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top