Sujet Précédent Sujet Suivant

Ajout d'un racourcie clavier dans un composant add-in pour excel

cs_CRS Messages postés 3 Date d'inscription mardi 6 mai 2003 Statut Membre Dernière intervention 20 octobre 2004 - 20 oct. 2004 à 20:08
petiflamand Messages postés 675 Date d'inscription samedi 31 mai 2003 Statut Membre Dernière intervention 26 mai 2013 - 20 oct. 2004 à 21:08
Hello All,

Alors voila j'ai fait un add-in pour excel

Voici mon 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

Mon icon es bien créer dans m'a barre d'outils standard de excel mais je n'arrive pas a atribuer de racourcie clavier a se bouton.

Si quelqu'un sais comment fair sa m'arrangerai bien.

@++

CRS

2 réponses

Réponse 1 / 2
petiflamand Messages postés 675 Date d'inscription samedi 31 mai 2003 Statut Membre Dernière intervention 26 mai 2013 1
20 oct. 2004 à 21:06
desoler je suis sur vb5 et il en veu pas ???????
0
Réponse 2 / 2
petiflamand Messages postés 675 Date d'inscription samedi 31 mai 2003 Statut Membre Dernière intervention 26 mai 2013 1
20 oct. 2004 à 21:08
desoler je suis sur vb5 et il en veu pas ???????
0

Discussions similaires

Remplir un formulaire PDF à partir di'un fichier excel
bgame -
the_little_big_man -

3 réponses
EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
Ajout d'une colonne de type non null
cs_RMI -
Antoine Crochet-Damais -

5 réponses
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
Les fonctions " racines niemmes " et " arctan "et "arccos " et "arcsin"
labriji -
labriji -

6 réponses
Rejoignez-nous