Microsoft 365 Remplissage automatique d'une feuille à l'autre

Todre · 19 Décembre 2023

Bonjour à tous,

Je possède un fichier Excel pour le suivi de mes véhicules. J'ai une feuille qui me sert d'ordre d'exécution que je dois donner à mon conducteur pour pouvoir aller au garage avec qui servira plus tard pour la facturation avec mes gestionnaires de flotte.
En parallèle, j'ai créer une feuille pour avoir un suivi perso de mes véhicules à l'année.
J'aimerai, lorsque je rempli ma feuille perso, que certaines infos (2 voir 3) viennent remplir la feuille 1 (l'ordre d'exécution). Lorsque je remplis une nouvelle ligne cela remplis de nouveau la feuille avec les nouvelles informations ainsi de suite comme ca je suis capable de sortir à tt moment un historique Excel de mes véhicules.
En prime, si je peux avoir un bouton "envoyer par mail en pdf" et "imprimer" ce serait top de chez top.
Pour info la feuille ordre d'exécution (feuille 1) va déjà chercher des infos dans des feuilles masquées suivant ma saisie.

Pouvez vous me dire si cela est possible ? Je ne peux pas mettre en partage le fichier, il contient beaucoup d'informations RGPD.

D'avance merci à vous pour votre aide

Phil69970 · 9 Janvier 2024

Je te propose

Dans le code "Sub info" tu rajoutes ces lignes

VB:

        Select Case .Range("H" & Lig) '.Value
        Case "GROUPE DEKRA VL (NORISKO, AUTOCONTROL)"
            Ws1.Range("B11") = "Controle_technique"
        Case "80136 RIVERY - GARAGE GUEUDET SARVA"
            Ws1.Range("B11") = "MECANIQUE_LOURDE"
        Case Else
            Ws1.Range("B11") = ""
        End Select

Tu fais les tests etc...... fonctionne sur toutes les lignes ...

Todre · 9 Janvier 2024

pour dekra c'est ok, pour renault j'ai une case vide

Phil69970 · 9 Janvier 2024

Normalement si j'ai suivi pour Renault tu dois avoir cela (pour l'exemple en H6) feuille "Suivi véhicules"

Todre · 9 Janvier 2024

non c'est vide

Phil69970 · 9 Janvier 2024

zut je me suis trompé de garage

remplace dans la macro

Case "80136 RIVERY - GARAGE GUEUDET SARVA"

par

Case "80330 LONGUEAU - GARAGE LAPORTE"

Phil69970 · 9 Janvier 2024

Et pour ta dernière demande

Je te propose

Dans le code "Sub info" tu rajoutes ces lignes

VB:

        '**********Ligne à rajouter'
        Dim i&, Derlig&
        Derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 6 To Derlig
            If .Range("I" & i) <> "" Then
                ' Tu choisis parmi les 4 couleurs vertes celle que tu veux
                .Range("A" & i & ":L" & i).Interior.ColorIndex = 4 '<== 4 ou 10 ou 43 ou 50
            Else
                .Range("A" & i & ":L" & i).Interior.ColorIndex = xlColorIndexNone
            End If
        Next i
        '********** Fin de ligne Ligne à rajouter'

Phil69970 · 9 Janvier 2024

Vérifie que dans la feuille fournisseurs il n'y a pas un espace à la fin des noms ou au début voir l'exemple
que j'ai fait

En principe l'espace traine plutôt à la fin !!!

Todre · 9 Janvier 2024

J'ai quasi tout ok, il me manque juste pour le garage Renault.

Le code actuel:

Sub Info()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig&, Col&

Lig = ActiveCell.Row
Col = ActiveCell.Column

If Col = 2 And Lig > 5 And ActiveCell.Value <> "" Then
Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
Set Ws2 = Worksheets("Suivi véhicules") 'Source
With Ws2
Dim i&, Derlig&
Derlig = .Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To Derlig
If .Range("I" & i) <> "" Then

.Range("A" & i & ":L" & i).Interior.ColorIndex = 4
Else
.Range("A" & i & ":L" & i).Interior.ColorIndex = xlColorIndexNone
End If
Next i
Ws1.Range("B7") = .Range("B" & Lig)
Ws1.Range("B20") = .Range("E" & Lig)
Ws1.Range("B30") = .Range("F" & Lig)

Ws1.Range("D11") = .Range("H" & Lig)
Select Case .Range("H" & Lig) '.Value
Case "GROUPE DEKRA VL (NORISKO, AUTOCONTROL)"
Ws1.Range("B11") = "Controle_technique"
Case "80330 LONGUEAU - GARAGE LAPORTE"
Ws1.Range("B11") = "MECANIQUE_LOURDE"
Case Else
Ws1.Range("B11") = ""
End Select
End With
Else
MsgBox "Pas de véhicule choisi !", vbExclamation, "Essaye encore !"
End If

Set Ws1 = Nothing: Set Ws2 = Nothing
End Sub

Sub RAZ() 'Pas sur qu cela soit utile maintenant
Application.ScreenUpdating = False
Dim Ws1 As Worksheet

Set Ws1 = Worksheets("BON DE COMMANDE") 'Source
With Ws1
.Range("B7") = "" 'Immat
.Range("B20") = "" 'Motif
.Range("B30") = "" 'Date depose
End With
Set Ws1 = Nothing
End Sub

Sub Impression()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Derlig%

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
With Ws1.PageSetup
Derlig = Range("A" & Rows.Count).End(xlUp).Row
.PrintArea = "$A$2:$E$53" 'Zone d'impression
.FitToPagesWide = 1 'Contrôle la largeur de la page
End With
Sheets(Ws1.Name).PrintOut 'Imprime la feuille
Set Ws1 = Nothing
End Sub

Sub ExportPDF()
Dim Chemin$, NFichier$, Ws1 As Worksheet, MaDate$

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination

'La ou se trouve ton fichier excel
'Chemin = ActiveWorkbook.Path & "\"
'Chemin = "C:\Users\VL6229\OneDrive - GRDF\Bureau\Bon Véhicules\2024" & "\" 'Chemin en dur dans le code
Chemin = Worksheets("Suivi véhicules").Range("E4") & "\" 'Chemin en dur dans la feuille

If Worksheets("Suivi véhicules").Range("E4") = "" Then MsgBox "Il manque le chemin cellule E4 !!!", vbCritical, "Pas de bol !": Exit Sub

If Ws1.Range("B7").Value = "" Or Ws1.Range("B30") = "" Then
MsgBox "C'est quoi ce binzzzz !... Il n'y a pas d'immatriculation et/ou de date valide", vbCritical, "Tu fais n'importe quoi !"
Exit Sub
End If

MaDate = Ws1.Range("B30") '==> Date de depose
MaDate = Format(MaDate, "yyyy-mm-dd")

NFichier = Ws1.Range("B7").Value & "-" & MaDate & ".pdf"

If Dir(Chemin & NFichier) <> "" Then
'le fichier existe déjà et suivant réponse de l'utilisateur
If MsgBox("Le fichier existe déjà, voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Confirmation") = vbYes Then
'Création du fichier PDF
Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
"Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
Else
MsgBox "Le PDF n'a pas été crée", vbCritical, "Le fichier existe déjà"
Exit Sub
End If
Else 'créer le pdf
Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
"Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
End If
End Sub

Todre · 9 Janvier 2024

J'ai bien mes colonnes qui se sont mises en vertes sur l'existant mais quand je rentre une date de récupération ca ne change rien

Todre · 9 Janvier 2024

Phil69970 à dit:
Vérifie que dans la feuille fournisseurs il n'y a pas un espace à la fin des noms ou au début voir l'exemple
que j'ai fait
Regarde la pièce jointe 1188089

En principe l'espace traine plutôt à la fin !!!

non pas d'espace

Phil69970 · 9 Janvier 2024

Oulala sans l'indentation c'est super difficile à déchiffrer !!

Tu devrais avoir ceci qui fonctionne chez moi

VB:

Sub Info()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig&, Col&

Lig = ActiveCell.Row
Col = ActiveCell.Column

If Col = 2 And Lig > 5 And ActiveCell.Value <> "" Then
    Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
    Set Ws2 = Worksheets("Suivi véhicules") 'Source
    With Ws2
        Dim i&, Derlig&
        Derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 6 To Derlig
            If .Range("I" & i) <> "" Then
                ' Tu choisis parmi les 4 couleurs vertes celle que tu veux
                .Range("A" & i & ":L" & i).Interior.ColorIndex = 4 '<== 4 ou 10 ou 43 ou 50
            Else
                .Range("A" & i & ":L" & i).Interior.ColorIndex = xlColorIndexNone
            End If
        Next i
 
        Ws1.Range("B7") = .Range("B" & Lig)
        Ws1.Range("B20") = .Range("E" & Lig)
        Ws1.Range("B30") = .Range("F" & Lig)
        Ws1.Range("D11") = .Range("H" & Lig)
        Select Case .Range("H" & Lig) '.Value
        Case "GROUPE DEKRA VL (NORISKO, AUTOCONTROL)"
            Ws1.Range("B11") = "Controle_technique"
        Case "80330 LONGUEAU - GARAGE LAPORTE"
            Ws1.Range("B11") = "MECANIQUE_LOURDE"
        Case Else
            Ws1.Range("B11") = ""
        End Select
    End With
Else
    MsgBox "Pas de véhicule choisi !", vbExclamation, "Essaye encore !"
End If

Set Ws1 = Nothing: Set Ws2 = Nothing
End Sub

Sub RAZ() 'Pas sur qu cela soit utile maintenant
Application.ScreenUpdating = False
Dim Ws1 As Worksheet

Set Ws1 = Worksheets("BON DE COMMANDE") 'Source
With Ws1
    .Range("B7") = ""    'Immat
    .Range("B20") = ""   'Motif
    .Range("B30") = ""   'Date depose
End With
Set Ws1 = Nothing
End Sub

Sub Impression()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Derlig%

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
With Ws1.PageSetup
    Derlig = Range("A" & Rows.Count).End(xlUp).Row
    .PrintArea = "$A$2:$E$53"           'Zone d'impression
    .FitToPagesWide = 1                 'Contrôle la largeur de la page
End With
Sheets(Ws1.Name).PrintOut               'Imprime la feuille
Set Ws1 = Nothing
End Sub

Sub ExportPDF()
Dim Chemin$, NFichier$, Ws1 As Worksheet, MaDate$

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination

'La ou se trouve ton fichier excel
Chemin = Worksheets("Suivi véhicules").Range("E4") & "\"                    'Chemin en dur dans la feuille

If Worksheets("Suivi véhicules").Range("E4") = "" Then MsgBox "Il manque le chemin cellule E4 !!!", vbCritical, "Pas de bol !": Exit Sub

If Ws1.Range("B7").Value = "" Or Ws1.Range("B30") = "" Then
    MsgBox "C'est quoi ce binzzzz !... Il n'y a pas d'immatriculation et/ou de date valide", vbCritical, "Tu fais n'importe quoi !"
    Exit Sub
End If

MaDate = Ws1.Range("B30") '==> Date de depose
MaDate = Format(MaDate, "yyyy-mm-dd")

NFichier = Ws1.Range("B7").Value & "-" & MaDate & ".pdf"

If Dir(Chemin & NFichier) <> "" Then
    'le fichier existe déjà et suivant réponse de l'utilisateur
    If MsgBox("Le fichier existe déjà, voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Confirmation") = vbYes Then
        'Création du fichier PDF
        Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
    Else
        MsgBox "Le PDF n'a pas été crée", vbCritical, "Le fichier existe déjà"
        Exit Sub
    End If
Else    'créer le pdf
    Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
    MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
End If
End Sub

C'est plus lisible comme ceci

Le code ce met à jour à chaque Mise à jour info ! (c'est modifiable bien sur )

Todre · 9 Janvier 2024

je viens de mettre ton code, ca fonctionne pour dekra mais toujours pas pour renault.

La ligne verte ne se met toujours pas lorsque je mets la date de récupération

Phil69970 · 9 Janvier 2024

Je te propose ce code qui remplace en totalité l'ancien code
La partie verte se met à jour dès que tu cliques sur le bouton bleu "MAJ info" et que tu sois n’importe où !

VB:

Sub Info()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig&, Col&, i&, Derlig&

Lig = ActiveCell.Row
Col = ActiveCell.Column

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
Set Ws2 = Worksheets("Suivi véhicules") 'Source

Derlig = Ws2.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To Derlig
    If Ws2.Range("I" & i) <> "" Then
        ' Tu choisis parmi les 4 couleurs vertes celle que tu veux
        Ws2.Range("A" & i & ":L" & i).Interior.ColorIndex = 4 '<== 4 ou 10 ou 43 ou 50
    Else
        Ws2.Range("A" & i & ":L" & i).Interior.ColorIndex = xlColorIndexNone
    End If
Next i
        
If Col = 2 And Lig > 5 And ActiveCell.Value <> "" Then
    With Ws2
        Ws1.Range("B7") = .Range("B" & Lig)
        Ws1.Range("B20") = .Range("E" & Lig)
        Ws1.Range("B30") = .Range("F" & Lig)
        Ws1.Range("D11") = .Range("H" & Lig)
        
        Select Case .Range("H" & Lig)
        Case "GROUPE DEKRA VL (NORISKO, AUTOCONTROL)"
            Ws1.Range("B11") = "Controle_technique"
        Case "80330 LONGUEAU - GARAGE LAPORTE"
            Ws1.Range("B11") = "MECANIQUE_LOURDE"
        Case Else
            Ws1.Range("B11") = ""
        End Select
    End With
Else
    MsgBox "Pas de véhicule choisi !", vbExclamation, "Essaye encore !"
End If

Set Ws1 = Nothing: Set Ws2 = Nothing
End Sub

Sub RAZ() 'Pas sur qu cela soit utile maintenant
Application.ScreenUpdating = False
Dim Ws1 As Worksheet

Set Ws1 = Worksheets("BON DE COMMANDE") 'Source
With Ws1
    .Range("B7") = ""    'Immat
    .Range("B20") = ""   'Motif
    .Range("B30") = ""   'Date depose
End With
Set Ws1 = Nothing
End Sub

Sub Impression()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Derlig%

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
With Ws1.PageSetup
    Derlig = Range("A" & Rows.Count).End(xlUp).Row
    .PrintArea = "$A$2:$E$53"           'Zone d'impression
    .FitToPagesWide = 1                 'Contrôle la largeur de la page
End With
Sheets(Ws1.Name).PrintOut               'Imprime la feuille
Set Ws1 = Nothing
End Sub

Sub ExportPDF()
Dim Chemin$, NFichier$, Ws1 As Worksheet, MaDate$

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination

Chemin = Worksheets("Suivi véhicules").Range("E4") & "\"                    'Chemin en dur dans la feuille

If Worksheets("Suivi véhicules").Range("E4") = "" Then MsgBox "Il manque le chemin cellule E4 !!!", vbCritical, "Pas de bol !": Exit Sub

If Ws1.Range("B7").Value = "" Or Ws1.Range("B30") = "" Then
    MsgBox "C'est quoi ce binzzzz !... Il n'y a pas d'immatriculation et/ou de date valide", vbCritical, "Tu fais n'importe quoi !"
    Exit Sub
End If

MaDate = Ws1.Range("B30") '==> Date de depose
MaDate = Format(MaDate, "yyyy-mm-dd")

NFichier = Ws1.Range("B7").Value & "-" & MaDate & ".pdf"

If Dir(Chemin & NFichier) <> "" Then
    'le fichier existe déjà et suivant réponse de l'utilisateur
    If MsgBox("Le fichier existe déjà, voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Confirmation") = vbYes Then
        'Création du fichier PDF
        Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
    Else
        MsgBox "Le PDF n'a pas été crée", vbCritical, "Le fichier existe déjà"
        Exit Sub
    End If
Else    'créer le pdf
    Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
    MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
End If
End Sub

Phil69970 · 9 Janvier 2024

Jeu des 4 erreurs
80330 LONGUEAU - GARAGE LAPORTE
ou
80330 LONGUEAU - GARAGE LAPORTE
ou
80330 LONGUEAU - GARAGE LAPORTE
ou
8O330 L0NGUEAU - GARAGE LAPORTE

Réponse ici

Et je te l'ai dit depuis un moment !!!

Todre · 9 Janvier 2024

Pour le moment c'est ok, fin du game pour aujourd'hui sinon le PC va voler je crois et j'imagine que pour toi ca doit être pire ! pour le moment j'ai le fichier que je voulais on recroise le tout demain et j'espère on clôture le truc pour de bon

Merci encore une fois pour ta patience du jour !

Bonne soirée Phil

Microsoft 365 Remplissage automatique d'une feuille à l'autre

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Partager cette page

Statistiques des forums