Microsoft 365 Changer le format de 2 colonnes à partir d'un fichier généré auto

MOA_Excel · 1 Septembre 2021

Bonjour,

Dans le code ci-dessous, je souhaiterais ajouter le fait que dans le nouveau fichier créé (après avoir fait le copié/collé valeur), les colonnes Q et X présentent un format minimal de 00 (dans le cas où j'ai un 7 par exemple, j'ai 07 qui s'affiche). En revanche, si j'ai 13140, ça doit rester ainsi. Et si je n'ai rien dans la cellule, il faut que ça reste vide ( et pas 00). Exemple problématique : dans le fichier Excel ci-joint (nouveau fichier généré via la macro), la cellule Q47 se trouve avec un 6 et non un 06

Avec toutes les tentatives et après être allé chercher l'info dans des tutos, je n'arrive pas à utiliser correctement Formatnumber

Merci par avance de votre aide !

Bien cordialement

JA

VB:

Sub GENERER_NOUVEAU_FICHIER_IMPORT_CLIENT()
Dim ChDir As String, nmFich As String
ChDir = "\\ADIO-FILES\datas\ENTREPRISE\20-Exploitation\ETL_Exploitation\4 - Résas_Client\"
nmFich = Sheets("Référentiel").Range("X21").Value & ".csv"
With ThisWorkbook
    AfficheDebloque .Sheets("Import SUD"), "ETL"
    .Sheets("Import SUD").Copy
    With ActiveWorkbook
        .Sheets(1).Range("A1:DC10000").Value = .Sheets(1).Range("A1:DC10000").Value
        'application.displayalerts = false
        .SaveAs Filename:=ChDir & nmFich, FileFormat:=xlCSV, Local:=True, CreateBackup:=False
        'application.displayalerts = true
        .Close
    End With
    CacheBloque .Sheets("Import SUD"), "ETL"
End With
End Sub

Sub AfficheDebloque(Feuille As Worksheet, Optional Password As String)
With Feuille
    .Unprotect Password
    .Visible = True
End With
End Sub

Sub CacheBloque(Feuille As Worksheet, Optional Password As String)
With Feuille
    .Visible = False
    .Protect Password
End With
End Sub

job75 · 1 Septembre 2021

Bonjour MOA_Excel,

MOA_Excel à dit:
Dans le code ci-dessous, je souhaiterais ajouter le fait que dans le nouveau fichier créé (après avoir fait le copié/collé valeur), les colonnes Q et X présentent un format minimal de 00

VB:

Dim ChDir As String, nmFich As String, c As Range
'------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .Sheets(1).Range("A1:DC10000") = .Sheets(1).Range("A1:DC10000").Value
        With .Sheets(1).Range("Q:Q,X:X")
            If Application.Count(.Cells) Then
                .NumberFormat = "@" 'format Texte
                For Each c In .SpecialCells(xlCellTypeConstants, 1)
                    If Len(c.Value) = 1 Then c = 0 & c
                Next...

job75 · 1 Septembre 2021

Bonjour MOA_Excel,

MOA_Excel à dit:
Dans le code ci-dessous, je souhaiterais ajouter le fait que dans le nouveau fichier créé (après avoir fait le copié/collé valeur), les colonnes Q et X présentent un format minimal de 00

VB:

Dim ChDir As String, nmFich As String, c As Range
'------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .Sheets(1).Range("A1:DC10000") = .Sheets(1).Range("A1:DC10000").Value
        With .Sheets(1).Range("Q:Q,X:X")
            If Application.Count(.Cells) Then
                .NumberFormat = "@" 'format Texte
                For Each c In .SpecialCells(xlCellTypeConstants, 1)
                    If Len(c.Value) = 1 Then c = 0 & c
                Next
            End If
        End With
        .SaveAs Filename:=ChDir & nmFich, FileFormat:=xlCSV, Local:=False, CreateBackup:=False
        .Close
    End With

Le fichier CSV doit être créé avec Local:=False pour éviter la conversion de 06 en 6.

A+

MOA_Excel · 1 Septembre 2021

job75 à dit:

Bonjour MOA_Excel,

VB:

Dim ChDir As String, nmFich As String, c As Range
'------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .Sheets(1).Range("A1:DC10000") = .Sheets(1).Range("A1:DC10000").Value
        With .Sheets(1).Range("Q:Q,X:X")
            If Application.Count(.Cells) Then
                .NumberFormat = "@" 'format Texte
                For Each c In .SpecialCells(xlCellTypeConstants, 1)
                    If Len(c.Value) = 1 Then c = 0 & c
                Next
            End If
        End With
        .SaveAs Filename:=ChDir & nmFich, FileFormat:=xlCSV, Local:=False, CreateBackup:=False
        .Close
    End With

Le fichier CSV doit être créé avec Local:=False pour éviter la conversion de 06 en 6.

A+

Bonjour Job75,

Merci pour votre aide, votre solution fonctionne !

Seule chose : j'ai dû laisser True car à défaut j'ai des virgules au lieu des points virgule, et l'import ne fonctionne plus

En revanche, bien que visuellement un 6 apparait au lieu du 06, avec le code que vous m'avez proposé, cette fois-ci le chargeur reconnaît la cellule en tant que 06 (dpt Alpes-Maritimes), donc solution validée !

Excellente journée
Bien cordialement

job75 · 1 Septembre 2021

Effectivement avec Local:=True ça va bien.

Quand on ouvre le fichier CSV avec Excel le zéro de 06 n'apparaît pas.

Mais il apparaît quand on ouvre le fichier avec le Bloc-notes.

MOA_Excel · 1 Septembre 2021

job75 à dit:
Effectivement avec Local:=True ça va bien.

Quand on ouvre le fichier CSV avec Excel le zéro de 06 n'apparaît pas.

Mais il apparaît quand on ouvre le fichier avec le Bloc-notes.

Malheureusement je me retrouve confronté cette fois-ci au pb de compatibilité entre 365 et 2013...

Quand j'exécute la macro sur 365, tout est nickel, quand c'est sur 2013, ça me refait le fichier Excel avec toutes les virgules ! Et ce pour la même macro.

job75 · 1 Septembre 2021

Essayez ce code, l'écriture séquentielle est bien plus simple et très rapide :

VB:

Sub GENERER_NOUVEAU_FICHIER_IMPORT_CLIENT()
Dim chemin$, nmFich$, tablo, ncol%, x%, i&, texte$, j%
chemin = "\\ADIO-FILES\datas\ENTREPRISE\20-Exploitation\ETL_Exploitation\4 - Résas_Client\"
nmFich = Sheets("Référentiel").Range("X21") & ".csv"
tablo = Sheets("Import SUD").UsedRange 'matrice, plus rapide
ncol = UBound(tablo, 2)
x = FreeFile
Open chemin & nmFich For Output As #x 'ouverture en écriture séquentielle
For i = 1 To UBound(tablo)
    If tablo(i, 17) Like "#" Then tablo(i, 17) = 0 & tablo(i, 17) 'colonne Q
    If tablo(i, 24) Like "#" Then tablo(i, 24) = 0 & tablo(i, 24) 'colonne X
    texte = ""
    For j = 1 To ncol
        texte = texte & ";" & tablo(i, j)
    Next j
    Print #x, Mid(texte, 2)
Next i
Close #x
End Sub

Il est inutile d'ôter la protection de la feuille source.

MOA_Excel · 2 Septembre 2021

job75 à dit:

Essayez ce code, l'écriture séquentielle est bien plus simple et très rapide :

VB:

Sub GENERER_NOUVEAU_FICHIER_IMPORT_CLIENT()
Dim chemin$, nmFich$, tablo, ncol%, x%, i&, texte$, j%
chemin = "\\ADIO-FILES\datas\ENTREPRISE\20-Exploitation\ETL_Exploitation\4 - Résas_Client\"
nmFich = Sheets("Référentiel").Range("X21") & ".csv"
tablo = Sheets("Import SUD").UsedRange 'matrice, plus rapide
ncol = UBound(tablo, 2)
x = FreeFile
Open chemin & nmFich For Output As #x 'ouverture en écriture séquentielle
For i = 1 To UBound(tablo)
    If tablo(i, 17) Like "#" Then tablo(i, 17) = 0 & tablo(i, 17) 'colonne Q
    If tablo(i, 24) Like "#" Then tablo(i, 24) = 0 & tablo(i, 24) 'colonne X
    texte = ""
    For j = 1 To ncol
        texte = texte & ";" & tablo(i, j)
    Next j
    Print #x, Mid(texte, 2)
Next i
Close #x
End Sub

Il est inutile d'ôter la protection de la feuille source.

Merci pour ce complément de réponse et le temps consacré à mon post, je vais actualiser le code

Excellente journée et à bientôt
Bien cordialement

Microsoft 365 Changer le format de 2 colonnes à partir d'un fichier généré auto

MOA_Excel

XLDnaute Nouveau

Pièces jointes

job75

job75

XLDnaute Barbatruc

MOA_Excel

XLDnaute Nouveau

job75

XLDnaute Barbatruc

MOA_Excel

XLDnaute Nouveau

job75

XLDnaute Barbatruc

MOA_Excel

XLDnaute Nouveau

Discussions similaires