_matt_44
XLDnaute Nouveau
Bonjour,
Voila je dois faire migrer une macro existante qui fonctionnait sous excel 2003 auparavant vers excel 2007.
Le fonctionnement de cette macro est le suivant :
1- une fenetre s'ouvre pour que l'on puisse parcourir le poste de travail et sélectionner un fichier texte préalablement générer par un logiciel métier.
2- On ouvre se fichier texte et la macro s'occupe de mettre en forme le contenu du fichier.
3-Une fois le traitement terminé, on peut enregistrer le fichier texte modifié par dessus celui que l'on vien d'ouvrir afin de pouvoir l'exploiter dans un logiciel nommé "NSBARCODEKEY".
Pour cela, j'ai modifier le ruban avec custom UI editor. Dont le code est présent ci dessous.
	
	
	
	
	
		
Ensuite j'ai ouvert le fichier excel en question et insérer la macro dans le "ThisWorkbook" a l'aide de l'éditeur visual basic. Dont le code est également présent ci dessous.
	
	
	
	
	
		
Mon problème est le suivant : J'ai une "erreur 400" entre l'étape 2 & 3 a la mise en forme du contenu du fichier texte et je n'arrive pas a voir d'ou elle provient? d'autre part, est t'il possible de faire en sorte de faire fonctionner la macro en dehos du "Thisworbook" et plutot dans un module ? Si oui, comment ? Je n'y suis pas arrivé.
Merci d'avance,
Matthieu
	
		
			
		
		
	
				
			Voila je dois faire migrer une macro existante qui fonctionnait sous excel 2003 auparavant vers excel 2007.
Le fonctionnement de cette macro est le suivant :
1- une fenetre s'ouvre pour que l'on puisse parcourir le poste de travail et sélectionner un fichier texte préalablement générer par un logiciel métier.
2- On ouvre se fichier texte et la macro s'occupe de mettre en forme le contenu du fichier.
3-Une fois le traitement terminé, on peut enregistrer le fichier texte modifié par dessus celui que l'on vien d'ouvrir afin de pouvoir l'exploiter dans un logiciel nommé "NSBARCODEKEY".
Pour cela, j'ai modifier le ruban avec custom UI editor. Dont le code est présent ci dessous.
		HTML:
	
	
	<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id = "Macro" label="Macro" insertAfterMso="TabView">
<group id="Message" label="Message">
<button id="BxTrad" label="BxTrad" onAction="ThisWorkbook.Init" size="large" imageMso="HappyFace" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>Ensuite j'ai ouvert le fichier excel en question et insérer la macro dans le "ThisWorkbook" a l'aide de l'éditeur visual basic. Dont le code est également présent ci dessous.
		Code:
	
	
	Option Explicit
Dim nbLignes As Integer
Sub Init(ByVal control As IRibbonControl)
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 FunctionMon problème est le suivant : J'ai une "erreur 400" entre l'étape 2 & 3 a la mise en forme du contenu du fichier texte et je n'arrive pas a voir d'ou elle provient? d'autre part, est t'il possible de faire en sorte de faire fonctionner la macro en dehos du "Thisworbook" et plutot dans un module ? Si oui, comment ? Je n'y suis pas arrivé.
Merci d'avance,
Matthieu
 
	 
 
		 
 
		 
 
		 
 
		 
 
		 
 
		 
 
		 
 
		 
 
		