[MACRO] Transfer de excel 2003 vers excel 2007

[_matt_44]

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.

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.

 

[Roland_M]

Re : [MACRO] Transfer de excel 2003 vers excel 2007

bonsoir,

voir ci-joint un exemple !

 

[JNP]

Re : [MACRO] Transfer de excel 2003 vers excel 2007

Bonjour le fil ,
Une autre solution avec palette flottante.
Autrement, il est fort possible de personnaliser le ruban, mais il va falloir utiliser un peu de XML et télécharger "Office 2007 Custom UI Editor". Quelques liens pratiques :
Ce lien n'existe plus
Ce lien n'existe plus
Voici comment créer votre propre ruban Office 2007 en 15 minutes !
Bon courage

 

[_matt_44]

Re : [MACRO] Transfer de excel 2003 vers excel 2007

Apres avoir regarder de plus près ton fichier "Roland_M" je l'ai modifier a ma guise en renommant les différentes parties ce qui donne ceci :

'------- dans le ThisWorkbook
'Private Sub Workbook_Activate()
'CreatBarMenuPerso
'End Sub
'Private Sub Workbook_Deactivate()
'SupprBarMenuPerso
'End Sub

'------- voir dans la Feuille
'Private Sub Worksheet_Activate()
'CreatBarMenuPerso
'End Sub
'Private Sub Worksheet_Deactivate()
'SupprBarMenuPerso
'End Sub
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'CreatBarMenuPerso
'End Sub

'REMARQUE dans excel 2007 le menu se place automatiquement dans un Onglet appelé "Compléments"

Public Const TitreBarreMenuPerso = "Menu Perso BxTrad"

'                                                                                               .
'                                   routines menu perso                                         .
Public Sub SupprBarMenuPerso()
On Error Resume Next
Application.CommandBars(TitreBarreMenuPerso).Delete
End Sub
Public Sub CreatBarMenuPerso()
SupprBarMenuPerso 'avant !
'créat barre menu  Position:= msoBarFloating msoBarBottom msoBarLeft msoBarRight msoBarTop
Set NewBarre = Application.CommandBars.Add(Name:=TitreBarreMenuPerso, Position:=msoBarLeft, MenuBar:=False, Temporary:=True)
Set BarMenu = NewBarre.Controls.Add(msoControlPopup)
BarMenu.Caption = Space(25) & "Macro BxTrad" & Space(25)
'1' Sélectionner un Répertoire
Set MenuSelectRep = BarMenu.Controls.Add(msoControlButton)
    MenuSelectRep.Caption = "Executer la Macro"
    MenuSelectRep.OnAction = "ExecuterMacro"

NewBarre.Visible = True
End Sub
Public Sub ExecuterMacro()
MsgBox "Lancement de la Macro BxTrad"
'???????????????????????????????????????????????????????????????????????????????'
'???????????????????????????????????????????????????????????????????????????????'

End Sub

Cependant je n'arrive pas à inclure la macro (dont j'ai mis la source dans le premier message) à la place des points d'intérrogations. Une erreur apparait lorsque que je l'execute "objet manquant".

Je précise aussi que je n'ai jamais fais de visual basic et que je suis débutant en la matière.
Si quelqu'un a une idée, je suis preneur !

Cordialement,
Matthieu GOUY