ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Help for add a short cut keyboard to my add-in (https://www.excelbanter.com/excel-programming/314174-help-add-short-cut-keyboard-my-add.html)

supercrs

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

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)
57 Then

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

--
supercr
-----------------------------------------------------------------------
supercrs's Profile: http://www.excelforum.com/member.php...fo&userid=1552
View this thread: http://www.excelforum.com/showthread.php?threadid=27091


sarahwhite0

I've seen the code you've provided, and it contains EAN-13 barcode. Does your component add-in supports creating EAN-13 barcode in Excel?


All times are GMT +1. The time now is 11:14 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com