_matt_44
XLDnaute Nouveau
Bonjour,
Voila à l'heure actuelle j'ai une macro qui tourne sous Excel 2003 que j'appelle via un bouton personnalisé qui se trouve dans ma barre d'outils avec les autres boutons par défaut d'excel.
J'aimerai pouvoir déplacer cette fonctionnalité sous Excel 2007, cependant je ne sais pas comment créer un bouton personnalisé dans le ruban ni comment refaire le lien avec cette macro.
Cependant, j'ai réussi a récupérer le code visual basic de cette macro cela peut sans doute vous aidez a résoudre mon problème.
De plus, j'ai inclus dans un fichier zip les fichiers nécessaires a son fonctionnement.
Si quelqu'un d'entre vous pourrai m'aider, merci d'avance.
Matthieu.
Voila à l'heure actuelle j'ai une macro qui tourne sous Excel 2003 que j'appelle via un bouton personnalisé qui se trouve dans ma barre d'outils avec les autres boutons par défaut d'excel.
J'aimerai pouvoir déplacer cette fonctionnalité sous Excel 2007, cependant je ne sais pas comment créer un bouton personnalisé dans le ruban ni comment refaire le lien avec cette macro.
Cependant, j'ai réussi a récupérer le code visual basic de cette macro cela peut sans doute vous aidez a résoudre mon problème.
Code:
Option Explicit
Dim nbLignes As Integer
Sub Init()
Dim cellule As Range
Dim cellule2 As Range
' Lancement des différentes procédures
' 1 -> Récupération du nom de fichier
Dim fichier As String ' Le fichier texte
Dim chemin As String ' le chemin du fichier
fichier = GetImportFileName("Fichier texte (*.txt), *.txt," & _
"Fichier délimité par des virgules (*.csv), *.csv," & _
"Tous les fichiers (*.*),*.*", _
1, "Fichier à traiter :")
chemin = ExtractPath(fichier)
ChDir chemin
' 2-> Ouverture du fichier
Workbooks.OpenText filename:=fichier, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Tab:=False, _
semicolon:=True, _
Comma:=False, _
Space:=False, _
FieldInfo:=Array(Array(1, 2), _
Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), _
Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 1), Array(13, 2), Array(14, 2), Array(15 _
, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), _
Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), Array( _
28, 2), Array(29, 2), Array(30, 2), Array(31, 1), Array(32, 1), Array(33, 2), Array(34, 2), _
Array(35, 2), Array(36, 2), Array(37, 2), Array(38, 2), Array(39, 2), Array(40, 2), Array( _
41, 2), Array(42, 2))
' 3-> Comptage des lignes à modifier. On se base sur la colonne n°4 (SSCC)
nbLignes = 0
Range("D1").Select
Range(Selection, Selection.End(xlDown)).Select
For Each cellule In Selection
If cellule.Value <> "" Then
nbLignes = nbLignes + 1
End If
Next
' 4-> Insertion de la ligne de titre, des titres et formatage des colonnes
' Insertion ligne
Rows("1:1").Select
Selection.Insert Shift:=xlDown
' colonne 1, Nombre d'exemplaire, Numérique
Formate "A", "NBEXEMPL", "0"
' colonne 2, Type de la palette, AlphaNumérique
' Type = 1 : homogéne standard
' Type = 2 : homogéne non standard
' Type = 3 : hétérogéne standard
' Type = 4 : hétérogéne non standard
Formate "B", "TYPE", "@"
' colonne 3, Numéro d'identifiant du SSCC, AlphaNumérique
Formate "C", "ID_SSCC", "@"
' colonne 4, SSCC de la palette, AlphaNumérique
Formate "D", "SSCC", "@"
' colonne 5, clé EAN de "3.ID SSCC + 4.Code SSCC", AlphaNumérique
Formate "E", "CLE_SSCC", "@"
' colonne 6, Numéro d'identifiant de l'EAN13 du produit, AlphaNumérique
Formate "F", "ID_GENCP", "@"
' colonne 7, "01" + "EAN13 du produit", AlphaNumérique
Formate "G", "GENCP", "@"
' colonne 8, Numéro d'identifiant de la DLUO, AlphaNumérique
Formate "H", "ID_DLUO", "@"
' colonne 9, DLUO, AlphaNumérique
Formate "I", "DLUO", "@"
' colonne 10, Clé EAN de "6.ID produit + 7.EAN produit + 8.ID DLUO + 9.DLUO", AlphaNumérique
Formate "J", "CLE_GD", "@"
' colonne 11, Numéro d'identifiant du nombre de colis dans la palette, AlphaNumérique
Formate "K", "ID_NBCOLIS", "@"
' colonne 12, Nombre de colis dans la palette, Numérique
Formate "L", "NBCOLIS", "0"
' colonne 13, Clé EAN de "6.ID Produit + 7.EAN Produit + 8.ID DLUO + 9.DLUO + 11.ID NB Colis + 12.Nb Colis", AlphaNumérique
Formate "M", "CLE_GDN", "@"
' colonne 14, Libellé n°1 du produit, AlphaNumérique
Formate "N", "LIB1", "@"
' colonne 15, Libellé n°2 du produit, AlphaNumérique
Formate "O", "LIB2", "@"
' colonne 16, Libellé n°3 du produit, AlphaNumérique
Formate "P", "LIB3", "@"
' colonne 17, Numéro d'identifiant du numéro du lot, AlphaNumérique
Formate "Q", "ID_LOT", "@"
' colonne 18, Numéro du lot, AlphaNumérique
Formate "R", "LOT", "@"
' colonne 19, Numéro d'identifiant de l'EAN du client livré, AlphaNumérique
Formate "S", "ID_GENCL", "@"
' colonne 20, EAN du client livré, AlphaNumérique
Formate "T", "GENCL", "@"
' colonne 21, Clé EAN de "19.ID client livré + 20.EAN client livré", AlphaNumérique
Formate "U", "CLE_CLIV", "@"
' colonne 22, EAN du client facturé, AlphaNumérique
Formate "V", "GENCF", "@"
' colonne 23, Numéro de commande, AlphaNumérique
Formate "W", "CDE", "@"
' colonne 24, Numéro d'identifiant du code postal du client livré, AlphaNumérique
Formate "X", "ID_CP", "@"
' colonne 25, Code postal du client livré, AlphaNumérique
Formate "Y", "CP", "@"
' colonne 26, Numéro d'identifiant de l'expédition, AlphaNumérique
Formate "Z", "ID_EXP", "@"
' colonne 27, EAN du transporteur, AlphaNumérique
Formate "AA", "GENCT", "@"
' colonne 28, Numéro de bordereau de déstockage, AlphaNumérique
Formate "AB", "BDX", "@"
' colonne 29, Clé EAN de "24.ID CP client livré + 25.CP Client livré + 26.ID expédition +
' 27.EAN Transporteur + 28.N° bordereau déstockage"
' AlphaNumérique
Formate "AC", "CLE_EXP", "@"
' colonne 30, Raison sociale n°1 du transporteur, AlphaNumérique
Formate "AD", "RSOC1TRP", "@"
' colonne 31, Numéro d'ordre de la palette dans la commande, Numérique
Formate "AE", "NOPAL", "0"
' colonne 32, Nombre total de palette dans la commande, Numérique
Formate "AF", "NBPAL", "0"
' colonne 33, Date de livraison prévue, AlphaNumérique
Formate "AG", "DATLIV", "@"
' colonne 34, Raison sociale n°1 du client livré, AlphaNumérique
Formate "AH", "RSOC1CL", "@"
' colonne 35, Raison sociale n°2 du client livré, AlphaNumérique
Formate "AI", "RSOC2CL", "@"
' colonne 36, Adresse n°1 du client livré, AlphaNumérique
Formate "AJ", "ADR1CL", "@"
' colonne 37, Adresse n°2 du client livré, AlphaNumérique
Formate "AK", "ADR2CL", "@"
' colonne 38, Ville du client livré, AlphaNumérique
Formate "AL", "VILLECL", "@"
' colonne 39, Pays du client livré, AlphaNumérique
Formate "AM", "PAYSCL", "@"
' colonne 40, Numéro de commande du client, AlphaNumérique
Formate "AN", "NUMCLI", "@"
' colonne 41, Firme du client, AlphaNumérique
Formate "AO", "FIRME", "@"
' colonne 42, Nom de l'utilisateur, AlphaNumérique
Formate "AP", "LOGIN", "@"
' 5-> Création du nom de la table
Set cellule = Range("A1")
Set cellule2 = cellule.Offset(nbLignes, 42)
Range(cellule, cellule2).Name = "Data"
' 6-> Sauvegarde du fichier
ActiveWorkbook.SaveAs filename:="EAN128.xls", _
FileFormat:=xlExcel9795, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub
Function NewExt(fichier As String, ext As String)
' Change l'extension du fichier
If Mid(fichier, Len(fichier) - 3, 1) <> "." Then
Exit Function
End If
NewExt = Left(fichier, Len(fichier) - 4) & ext
End Function
Sub Formate(colonne As String, titre As String, format As String)
' Formate le texte des cellules
' depuis la ligne 2 jusqu'à la ligne nbLignes
Dim texte As String
Dim cellule As Range
Dim cellule1 As Range
Dim cellule2 As Range
Dim jour As String
Dim mois As String
Dim annee As String
Range(colonne & "1").Select
Selection.Value = titre
Set cellule1 = Range(colonne & "2")
Set cellule2 = cellule1.Offset(nbLignes - 1, 0)
Range(cellule1, cellule2).Select
Selection.NumberFormat = "0" ' pour éviter que les nombres soient en notation exponentielle
If format = "@" Then
For Each cellule In Selection
texte = cellule.Text
If Left(texte, 1) = " " Then
texte = Right(texte, Len(texte) - 1)
End If
texte = "'" & texte
If titre = "DATLIV" Then
' Mise en forme de la date
If Len(texte) = 6 Then
texte = "'0" + Right(texte, 5)
End If
jour = Mid$(texte, 6, 2)
mois = Mid$(texte, 4, 2)
annee = Mid$(texte, 2, 2)
texte = "'" + jour + "/" + mois + "/" + annee
End If
cellule.Value = texte
Next cellule
End If
Selection.NumberFormat = format
Range(colonne & "1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Columns.AutoFit
End Sub
Function ExtractPath(f As String) As String
Dim i As Integer
For i = Len(f) To 1 Step -1
If Mid(f, i, 1) = "\" Then
ExtractPath = Left(f, i)
Exit Function
End If
Next i
End Function
Function GetImportFileName(Filt As String, FilterIndex As String, Prompt As String) As String
'Selects a single file for import
Dim filename As Variant
'
'Selects a file for export
'
'Use the following format to set up the filter
' Filt = "Text Files (*.txt),*.txt," & _
' "Lotus Files (*.prn),*.prn," & _
' "Comma Separated Files (*.csv),*.csv," & _
' "ASCII Files (*.asc),*.asc," & _
' "XML Files (*.xml),*.xml," & _
' "All Files (*.*),*.*"
'
' The Filter Index controls what filter is selected by default. It starts
' at zero. For the above example, you would set the filter index to 5 to
' select "All Files"
' Get the file name
filename = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Prompt)
' Exit if dialog box canceled
If filename = False Then
GetImportFileName = ""
Else
GetImportFileName = filename
End If
End Function
De plus, j'ai inclus dans un fichier zip les fichiers nécessaires a son fonctionnement.
Si quelqu'un d'entre vous pourrai m'aider, merci d'avance.
Matthieu.