Définition de commande macro Résolu

Question

Bonjour,

A partir d'un fichier csv je dois modifier les cellules d'une colonne pour la passer a 10 caractères

Pour cela j'ai écris une macro 
Qui modifie les cellules de la colonne pas de problèmes jusque là ça fonctionne.
Puis qui sauvegarde mon document en gardant le format csv avec comme séparateur de champs le point virgule,je dois fermer l'appli excel et la j'ai la question suivante :

========================================================================
Fichier.csv peut contenir des informations non compatibles avec CSV (séparateur : point virgule).Voulez-vous conserver le format du classeur ?

*Cliquez sur Oui pour conserver le format.Les fonctionnalités non compatibles seront perdues.
*Cliquez sur Non pour conserver ces caractéristiques.Enregistrez ensuite une copie de votre document dans le format de fichier Excel le plus récent.
*Cliquez sur Aide pour vérifier les pertes possibles.

                               Oui      Non    Aide
========================================================================


Comment paramétrer ma macro pour que celle-ci réponde oui implicitement a cette question.

Merci de votre aide.

stephbret56 · Answer

Je ne comprend pas bien ta solution, tu peu être un peut plus précis.merci

NicoDisso · Answer

en fait, tu pourrais tres bien ecrire toi meme dans un fichier au format csv...
ce n'est qu'un fichier texte avec un separateur

stephbret56 · Answer

Non ce n'est pas possible le fichier d'origine (excel) et un fichier qui met transmis d'une société extérieure il m'est impossible d'obliger celle-ci à écrire dans un fichier csv , je suis d'accord avec toi la meilleure solution c'est bien la tienne mais j'ai d'énorme contrainte.

Donc le pb reste entier comment faire à partir d'excel???

NicoDisso · Answer

ce que je veux dire c'est qu'avec excel, en VBA tu fais ça et du coup, leur fichier Excel sera converti en csv par toi meme sans passer par enregistrer sous de excel...

soit tu me met le cfichier en ligne, soit tu me dis le nom des colonnes que tu veux mettre dans ton fichier..
je te donnerai le code à écrire en fonction...

stephbret56 · Answer

Ok les colonnes sont les suivantes:

Pour la ligne 1:

Colonne A = 100
Colonne B = 64327
Colonne C = 234
Colonne D = 457
Colonne E = 5678
Colonne F = 90432
Colonne G = 4521
Colonne H = 567
Colonne I = 7842
Colonne J = 3589 

Pour la ligne 2:

Colonne A = 100
Colonne B = 645566
Colonne C = 4567
Colonne D = 9877
Colonne E = 56
Colonne F = 906
Colonne G = 4521555
Colonne H = 567098
Colonne I = 78432
Colonne J = 358

Pour la ligne 3:

Colonne A = 100
Colonne B = 9887867
Colonne C = 8
Colonne D = 90909
Colonne E = 4234
Colonne F = 7876896
Colonne G = 6
Colonne H = 34432
Colonne I = 90898000
Colonne J = 1

Voila j'espère que tu auras assez d'info avec ça sinon fait moi signe MERCI

NicoDisso · Answer

tu n'as que trois ligne dans ton fichier ?

stephbret56 · Answer

Non c'est un échantillon il peut y avoir 20 lignes comme 2000 .
Les colonnes sont toujours les mêmes pas plus pas moins et les cellules sont alimentées qu'avec des chiffres.

NicoDisso · Answer

merci, j'ai eut peur...

stephbret56 · Answer

Pas de panique je n'aurai jamais insisté autant pour 3 lignes 

Merci A+

NicoDisso · Answer

ll faut juste cocher "microsoft scripting runtime" dans le menu outils / références dans VBA

ensuite dans un module tu colles tout ce qui est en gras

Option Explicit

Dim Fso As FileSystemObject

'DETAIL DE L'ADRESS
Type Export_csv
    Colonne_A As String
    Colonne_B As String
    Colonne_C As String
    Colonne_D As String
    Colonne_E As String
    Colonne_F As String
    Colonne_G As String
    Colonne_H As String
    Colonne_I As String
    Colonne_J As String
End Type

'DETAIL DU FICHIER
Public Detail_Export_csv As Export_csv

'EMPLACEMENT DU FICHIER A CREER
Public Emplacement_Fichier As String

Private Function Ecriture_Entete() As Boolean
    
    Set Fso = New FileSystemObject
        
        Emplacement_Fichier = "C:\Export.csv"
        
        On Error Resume Next
            If Fso.FileExists(Emplacement_Fichier) = True Then
                Fso.DeleteFile Emplacement_Fichier, True
            End If
        On Error GoTo 0
    
    Set Fso = Nothing
    
    On Error Resume Next
        Open Emplacement_Fichier For Output As #1
        Select Case Err.Number
        Case Is = 0
            Ecriture_Entete = True
        Case 71
            MsgBox "Le support n'est pas accessible.", vbExclamation, "Message"
            Ecriture_Entete = False
        Case Else
            MsgBox Err.Description, vbExclamation, "Message"
            Ecriture_Entete = False
        End Select
    On Error GoTo 0
    
End Function

Private Function Ecriture_Detail(Colonne_A As String, Colonne_B As String, Colonne_C As String, Colonne_D As String, Colonne_E As String, Colonne_F As String, Colonne_G As String, Colonne_H As String, Colonne_I As String, Colonne_J As String) As Boolean
    
    Ecriture_Detail = False
    
    Detail_Export_csv.Colonne_A = Colonne_A
    Detail_Export_csv.Colonne_B = Colonne_B
    Detail_Export_csv.Colonne_C = Colonne_C
    Detail_Export_csv.Colonne_D = Colonne_D
    Detail_Export_csv.Colonne_E = Colonne_E
    Detail_Export_csv.Colonne_F = Colonne_F
    Detail_Export_csv.Colonne_G = Colonne_G
    Detail_Export_csv.Colonne_H = Colonne_H
    Detail_Export_csv.Colonne_I = Colonne_I
    Detail_Export_csv.Colonne_J = Colonne_J
    
    On Error Resume Next
        Print #1, Detail_Export_csv.Colonne_A & ";" & Detail_Export_csv.Colonne_B & ";" & Detail_Export_csv.Colonne_C & ";" & Detail_Export_csv.Colonne_D & ";" & Detail_Export_csv.Colonne_E & ";" & Detail_Export_csv.Colonne_F & ";" & Detail_Export_csv.Colonne_H & ";" & Detail_Export_csv.Colonne_I & ";" & Detail_Export_csv.Colonne_J
        If Err.Number = 0 Then
            Ecriture_Detail = True
        Else
            Ecriture_Detail = False
        End If
    On Error GoTo 0

End Function

Private Sub Ecriture_Fin()
    
    Close #1
        
End Sub

Public Sub Export()

    Call Ecriture_Entete
    
    Dim Colonne_A As String
    Dim Colonne_B As String
    Dim Colonne_C As String
    Dim Colonne_D As String
    Dim Colonne_E As String
    Dim Colonne_F As String
    Dim Colonne_G As String
    Dim Colonne_H As String
    Dim Colonne_I As String
    Dim Colonne_J As String

    Dim I As Integer
    Dim J As Integer
    
    I = 1
    
    Do Until ActiveSheet.Cells(I, 1).Value = ""
        For J = 1 To 10
            Select Case J
            Case 1
                Colonne_A = ActiveSheet.Cells(I, J).Value
            Case 2
                Colonne_B = ActiveSheet.Cells(I, J).Value
            Case 3
                Colonne_C = String(10 - Len(ActiveSheet.Cells(I, J).Value), "0") & ActiveSheet.Cells(I, J).Value
            Case 4
                Colonne_D = ActiveSheet.Cells(I, J).Value
            Case 5
                Colonne_E = ActiveSheet.Cells(I, J).Value
            Case 6
                Colonne_F = ActiveSheet.Cells(I, J).Value
            Case 7
                Colonne_G = ActiveSheet.Cells(I, J).Value
            Case 8
                Colonne_H = ActiveSheet.Cells(I, J).Value
            Case 9
                Colonne_I = ActiveSheet.Cells(I, J).Value
            Case 10
                Colonne_J = ActiveSheet.Cells(I, J).Value
            End Select
        Next J
                      
        If Ecriture_Detail(Colonne_A, Colonne_B, Colonne_C, Colonne_D, Colonne_E, Colonne_F, Colonne_G, Colonne_H, Colonne_I, Colonne_J) = False Then
           Exit Do
        End If
        
        I = I + 1
    Loop
    
            
    Call Ecriture_Fin

End Sub

il ne te reste plus qu'a lancer la macro Export et ton fichier sera sur C:\Export.csv avec ta colonne C sur 10 charactères

stephbret56 · Answer

Heu ben la c'est balaise j'comprend pas grand chose à ton script mais le problème n'est pas là j'essaierai de voir plus claire prochainement.

Que dois je faire du contenu de ma macro je conserve ou pas. 

Dans ton script tu met un End Sub mais y a pas de Sub je pense que c'est un oublie 

Donc dans l'hypothèse que je ne garde pas le contenu de ma macro cela veut dire que je fais un copier coller des lignes en gras à la place de ma macro et que je coche "microsoft scripting runtime"

Puis

j'enregistre ma macro. 

Je lance excel j'ouvre mon fichier excel et j'active la nouvelle macro à la fin de la procédure je dois avoir un fichier sous C: qui ce nomme export.csv c'est bien ça?

stephbret56 · Answer

Message pour NicoDisso,

Ecoute en insistant un peut je te confirme que ton script fonctionne à merveille.
Par contre j'ai juste a déclarer des colonnes en plus puisque je dois avoir de la colonne A à R je vais essayer de faire la modification de mon coté je te tiens au courant.

Merci beaucoup A+

NicoDisso · Answer

pour ce qui est du dernier "end sub", il correspond à "Public Sub Export()"

pour ce qui est du reste, tu remplaces effetcivement ta macro par tout le texte en gras et ça roule.

Pour ce qui est des colonnes, effectivement tu en déclares 8 de plus et par contre tu modifies également la boucle des J qui parcoure les colonnes afin qu'elle devienne

Do Until ActiveSheet.Cells(I, 1).Value = "" 
For J = 1 To 18 
Select Case J 
Case 1 
Colonne_A = ActiveSheet.Cells(I, J).Value 

sinon tu ne va exporter que les 10 premieres colonnes.

Au moins, j'espere que tu comprends ce que cela fait afin que tu puisse réexploiter cela plus tard si besoin...

Au fait, mois je mettrai cette macro dans mon classeru perso avec un bouton personnalisé afin d'avoir juste à cliquer sur le bouton lorsque je veux la mettre en marche depuis le fichier importé...

stephbret56 · Answer

ok si je comprend bien le passage suivant est une boucle c'est bien ça

Do Until ActiveSheet.Cells(I, 1).Value = ""
For J = 1 To 18
Select Case J
Case 1
Colonne_A = ActiveSheet.Cells(I, J).Value 

merci je vais mettre à jour ma macro et je te tiens au courant

A+

NicoDisso · Answer

en fait

Do Until ActiveSheet.Cells(I, 1).Value = "" => jusqu'a ce qu'il trouve un cellule en colonne A qui soit vide
For J = 1 To 10 => boucle pour chaque colonne
Select Case J 
Case 1 => suivant la colonne traite le contenu differement
Colonne_A = ActiveSheet.Cells(I, J).Value => mets dan sla variable colonne_A le contenu de la cellule qui correspond à la ligne et à la colonne 

du coup comme tu rajoutes des colonnes à exporter, il faut que ta boucle parcoure + de 10 colonnes

stephbret56 · Answer

Super ça marche Nickel je vois un peut plus claire sur le fonctionnement du script.

J'aurai peut-être encore un ptit peut besoin de toi pour la procédure  il faut que je l'affine par rapport au besoin je te tiens au courant.

Et encore un grand merci et chapeau pour la technique.

Bonne soirée et bon Week-end

A+

NicoDisso · Answer

de rien,
bon week end à toi aussi, il faudra juste voter pour les messages. Je ne sais pas à quoi ca sert, mais si il y en qui ont besoin d'info, ça peut etre bien..

NicoDisso · Answer

tu peux le faire à condition de dire à l'utilisateur de séparer les données qu'il saisit par un charactere spécial  style "|"
du coup avec la fonction split tu generes un tableau dont les données sont séparées par ton charactère.

ex : toto | titi 
variable 1 = toto
variable 2 = titi

moi, je prefere faire une userform avec  les champs qui vont bien, c'est plus sur car tu peux tester lors de la saisie et autorisé ou non la validation

pmfontaine38 · Answer

Bonjour,
Je souhaite utilisé cette macro Excel==>csv avec 30 colonnes.
J'ai réussi en en transferer 28 avec le code si dessous. Mais je n'arrive pas à ecrire les deux dernière sur la ligne qui commence par : Print #1, 
Pouvez-vous m'aider ?
Merci d'avance
Patrick

Option Explicit

Dim Fso As FileSystemObject
'DETAIL DE L'ADRESS
Type Export_csv
Colonne_A As String
Colonne_B As String
Colonne_C As String
Colonne_D As String
Colonne_E As String
Colonne_F As String
Colonne_G As String
Colonne_H As String
Colonne_I As String
Colonne_J As String
Colonne_K As String
Colonne_L As String
Colonne_M As String
Colonne_N As String
Colonne_O As String
Colonne_P As String
Colonne_Q As String
Colonne_R As String
Colonne_S As String
Colonne_T As String
Colonne_U As String
Colonne_V As String
Colonne_W As String
Colonne_X As String
Colonne_Y As String
Colonne_Z As String
Colonne_AA As String
Colonne_AB As String
Colonne_AC As String
Colonne_AD As String
End Type

'DETAIL DU FICHIER
Public Detail_Export_csv As Export_csv

'EMPLACEMENT DU FICHIER A CREER
Public Emplacement_Fichier As String
Private Function Ecriture_Entete() As Boolean
'Dim J, NombreLignes As Integer
Dim str, nom_fichier, Chemin As String
Dim f, fs


Set Fso = New FileSystemObject

Chemin = ThisWorkbook.Path & "\"
' Code
Sheets("cartoexploreur").Select
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
  ' On crée le fichier
Sheets("BD").Select
Emplacement_Fichier = Chemin + ActiveSheet.Cells(1, 27).Text

Sheets("cartoexploreur").Select
On Error Resume Next
If Fso.FileExists(Emplacement_Fichier) = True Then
Fso.DeleteFile Emplacement_Fichier, True
End If
On Error GoTo 0

Set Fso = Nothing

On Error Resume Next
Open Emplacement_Fichier For Output As #1
Select Case Err.Number
Case Is = 0
Ecriture_Entete = True
Case 71
MsgBox "Le support n'est pas accessible.", vbExclamation, "Message"
Ecriture_Entete = False
Case Else
MsgBox Err.Description, vbExclamation, "Message"
Ecriture_Entete = False
End Select
On Error GoTo 0

End Function

Private Function Ecriture_Detail(Colonne_A As String, Colonne_B As String, Colonne_C As String, Colonne_D As String, Colonne_E As String, Colonne_F As String, Colonne_G As String, Colonne_H As String, Colonne_I As String, Colonne_J As String, Colonne_K As String, Colonne_L As String, Colonne_M As String, Colonne_N As String, Colonne_O As String, Colonne_P As String, Colonne_Q As String, Colonne_R As String, Colonne_S As String, Colonne_T As String, Colonne_U As String, Colonne_V As String, Colonne_W As String, Colonne_X As String, Colonne_Y As String, Colonne_Z As String, Colonne_AA As String, Colonne_AB As String, Colonne_AC As String, Colonne_AD As String) As Boolean
Ecriture_Detail = False

Detail_Export_csv.Colonne_A = Colonne_A
Detail_Export_csv.Colonne_B = Colonne_B
Detail_Export_csv.Colonne_C = Colonne_C
Detail_Export_csv.Colonne_D = Colonne_D
Detail_Export_csv.Colonne_E = Colonne_E
Detail_Export_csv.Colonne_F = Colonne_F
Detail_Export_csv.Colonne_G = Colonne_G
Detail_Export_csv.Colonne_H = Colonne_H
Detail_Export_csv.Colonne_I = Colonne_I
Detail_Export_csv.Colonne_J = Colonne_J
Detail_Export_csv.Colonne_K = Colonne_K
Detail_Export_csv.Colonne_L = Colonne_L
Detail_Export_csv.Colonne_M = Colonne_M
Detail_Export_csv.Colonne_N = Colonne_N
Detail_Export_csv.Colonne_O = Colonne_O
Detail_Export_csv.Colonne_P = Colonne_P
Detail_Export_csv.Colonne_Q = Colonne_Q
Detail_Export_csv.Colonne_R = Colonne_R
Detail_Export_csv.Colonne_S = Colonne_S
Detail_Export_csv.Colonne_T = Colonne_T
Detail_Export_csv.Colonne_U = Colonne_U
Detail_Export_csv.Colonne_V = Colonne_V
Detail_Export_csv.Colonne_W = Colonne_W
Detail_Export_csv.Colonne_X = Colonne_X
Detail_Export_csv.Colonne_Y = Colonne_Y
Detail_Export_csv.Colonne_Z = Colonne_Z
Detail_Export_csv.Colonne_AA = Colonne_AA
Detail_Export_csv.Colonne_AB = Colonne_AB
Detail_Export_csv.Colonne_AC = Colonne_AC
Detail_Export_csv.Colonne_AD = Colonne_AD

On Error Resume Next
Print #1, Detail_Export_csv.Colonne_A & ";" & Detail_Export_csv.Colonne_B & ";" & Detail_Export_csv.Colonne_C & ";" & Detail_Export_csv.Colonne_D & ";" & Detail_Export_csv.Colonne_E & ";" & Detail_Export_csv.Colonne_F & ";" & Detail_Export_csv.Colonne_G & ";" & Detail_Export_csv.Colonne_H & ";" & Detail_Export_csv.Colonne_I & ";" & Detail_Export_csv.Colonne_J
Print #1, Detail_Export_csv.Colonne_K & ";" & Detail_Export_csv.Colonne_L & ";" & Detail_Export_csv.Colonne_M & ";" & Detail_Export_csv.Colonne_N & ";" & Detail_Export_csv.Colonne_O & ";" & Detail_Export_csv.Colonne_P & ";" & Detail_Export_csv.Colonne_Q & ";" & Detail_Export_csv.Colonne_R & ";" & Detail_Export_csv.Colonne_S & ";" & Detail_Export_csv.Colonne_T
Print #1, Detail_Export_csv.Colonne_U & ";" & Detail_Export_csv.Colonne_V & ";" & Detail_Export_csv.Colonne_W & ";" & Detail_Export_csv.Colonne_X & ";" & Detail_Export_csv.Colonne_Y & ";" & Detail_Export_csv.Colonne_Z & ";" & Detail_Export_csv.Colonne_AA & ";" & Detail_Export_csv.Colonne_AB & ";" & Detail_Export_csv.Colonne_AC & ";" & Detail_Export_csv.Colonne_AD

If Err.Number = 0 Then
Ecriture_Detail = True
Else
Ecriture_Detail = False
End If
On Error GoTo 0

End Function

Private Sub Ecriture_Fin()

Close #1

End Sub


Public Sub Export()

Call Ecriture_Entete

Dim Colonne_A As String
Dim Colonne_B As String
Dim Colonne_C As String
Dim Colonne_D As String
Dim Colonne_E As String
Dim Colonne_F As String
Dim Colonne_G As String
Dim Colonne_H As String
Dim Colonne_I As String
Dim Colonne_J As String
Dim Colonne_K As String
Dim Colonne_L As String
Dim Colonne_M As String
Dim Colonne_N As String
Dim Colonne_O As String
Dim Colonne_P As String
Dim Colonne_Q As String
Dim Colonne_R As String
Dim Colonne_S As String
Dim Colonne_T As String
Dim Colonne_U As String
Dim Colonne_V As String
Dim Colonne_W As String
Dim Colonne_X As String
Dim Colonne_Y As String
Dim Colonne_Z As String
Dim Colonne_AA As String
Dim Colonne_AB As String
Dim Colonne_AC As String
Dim Colonne_AD As String

Dim I As Integer
Dim J As Integer

I = 1

Do Until ActiveSheet.Cells(I, 1).Value = ""
For J = 1 To 30
Select Case J
Case 1
Colonne_A = ActiveSheet.Cells(I, J).Value
Case 2
Colonne_B = ActiveSheet.Cells(I, J).Value
Case 3
Colonne_C = ActiveSheet.Cells(I, J).Value
Case 4
Colonne_D = ActiveSheet.Cells(I, J).Value
Case 5
Colonne_E = ActiveSheet.Cells(I, J).Value
Case 6
Colonne_F = ActiveSheet.Cells(I, J).Value
Case 7
Colonne_G = ActiveSheet.Cells(I, J).Value
Case 8
Colonne_H = ActiveSheet.Cells(I, J).Value
Case 9
Colonne_I = ActiveSheet.Cells(I, J).Value
Case 10
Colonne_J = ActiveSheet.Cells(I, J).Value
Case 11
Colonne_K = ActiveSheet.Cells(I, J).Value
Case 12
Colonne_L = ActiveSheet.Cells(I, J).Value
Case 13
Colonne_M = ActiveSheet.Cells(I, J).Value
Case 14
Colonne_N = ActiveSheet.Cells(I, J).Value
Case 15
Colonne_O = ActiveSheet.Cells(I, J).Value
Case 16
Colonne_P = ActiveSheet.Cells(I, J).Value
Case 17
Colonne_Q = ActiveSheet.Cells(I, J).Value
Case 18
Colonne_R = ActiveSheet.Cells(I, J).Value
Case 19
Colonne_S = ActiveSheet.Cells(I, J).Value
Case 20
Colonne_T = ActiveSheet.Cells(I, J).Value
Case 21
Colonne_U = ActiveSheet.Cells(I, J).Value
Case 22
Colonne_V = ActiveSheet.Cells(I, J).Value
Case 23
Colonne_W = ActiveSheet.Cells(I, J).Value
Case 24
Colonne_X = ActiveSheet.Cells(I, J).Value
Case 25
Colonne_Y = ActiveSheet.Cells(I, J).Value
Case 26
Colonne_Z = ActiveSheet.Cells(I, J).Value
Case 27
Colonne_AA = ActiveSheet.Cells(I, J).Value
Case 28
Colonne_AB = ActiveSheet.Cells(I, J).Value
Case 29
Colonne_AC = ActiveSheet.Cells(I, J).Value
Case 30
Colonne_AD = ActiveSheet.Cells(I, J).Value
End Select
Next J

If Ecriture_Detail(Colonne_A, Colonne_B, Colonne_C, Colonne_D, Colonne_E, Colonne_F, Colonne_G, Colonne_H, Colonne_I, Colonne_J, Colonne_K, Colonne_L, Colonne_M, Colonne_N, Colonne_O, Colonne_P, Colonne_Q, Colonne_R, Colonne_S, Colonne_T, Colonne_U, Colonne_V, Colonne_W, Colonne_X, Colonne_Y, Colonne_Z, Colonne_AA, Colonne_AB, Colonne_AC, Colonne_AD) = False Then
Exit Do
End If

I = I + 1
Loop


Call Ecriture_Fin

End Sub

pmfontaine38 · Answer

Bonjour,
Désolé pour le doublon de mon message. Comme le premier n'apparaissait pas j'ai cru qu'il y avait une erreur de manip.
Et je ne sais pas supprimer le premier.
Patrick

Définition de commande macro

30 réponses

Discussions similaires

Newsletters