Englober 2 codes dans 1

Bonsoir a tous et toutes

voici 2 codes qui fonctionnent très bien autant l'un que l'autre, le premier permet d'envoyer dans un dossiers ou il y a 4 sous dossiers

afin d'enregistrer séparément les devis,factures, facture d'acompte et facture acquittée

donc ce code fonctionne très bien en enlevant les boutons et codes en .xlsx

Sub envoifacnue()    

Dim F As Worksheet    
Dim Chemin As String    
Dim Client As String    
Dim Sh As Shape    

  Set F = ThisWorkbook.Sheets(WS_FACTURE)    

  Select Case F.Range("D1")    
  Case "DEVIS"    
    Chemin = "D:\Facturation-v1s\Factureseule\Devis\"    
  Case "FACTURE ACOMPTE"    
    Chemin = "D:\Facturation-v1s\Factureseule\Facture acompte\"    
  Case "FACTURE ACQUITTEE"    
    Chemin = "D:\Facturation-v1s\Factureseule\Facture acquittée\"    
  Case "FACTURE"    
    Chemin = "D:\Facturation-v1s\Factureseule\Factures\"    
  Case Else    
    MsgBox "Impossibilité de déterminer le chemin" & vbCr & "Fin du programme"    
    End    
  End Select    

  Client = F.Range("DOC_TITRE") & " - " & F.Range("DOC_CLIENT")    

  Application.ScreenUpdating = False    

  F.Copy    
  With ActiveWorkbook    
    With .Sheets(1)    
      For Each Sh In .Shapes    
        If Sh.Type <> msoPicture Then    
          Sh.Delete    
        End If    
      Next Sh    

      .Cells.Copy    
      .Range("A1").PasteSpecial Paste:=xlPasteValues    
      .Range("A1").Select    
    End With    
    Application.DisplayAlerts = False  ' Si fichier identique présent : l'écrase sans alerte    
   .SaveAs Filename:=Chemin & Client & ".xlsx"    
    .Close    
  End With    
End Sub    

je voudrais si c'est possible de lui ajouter une option pour que lors de l'enregistrement par exemple

dans le sous dossier "devis" pourrai avoir un dossier qui se créer avec l'année en cours et dedans les mois de l'année afin d'enregistrer automatiquement dans le bon dossier ayant le bon nom de mois actuel

autrement j'ai trouvé ce code qui me plait car il créer automatiquement le dossier avec le nom du mois en cours plus les 2 derniers chiffres de l'année soit "Décembre-16" et le plus de ce code c'est que si le mois change il recréer un dossier "janvier-17"

tant que le mois n'est pas écoulé le mois n'est pas changer et l'on eux enregistrer des classeurs tant que l'on veux

ce que voudrais c'est faire un mix de ces codes afin qu'il fonctionne ensemble,

le must serai que le dossier avec l'année changeant soit aussi recréer

 Private Sub CommandButton1_Click()
      Application.DisplayAlerts = False
      Dim Chemin As String, Fichier As String, Rep As String
      Chemin = "C:\Users\vous-même\Desktop\Nouveau dossier\"
     'Chemin = ThisWorkbook.Path & "\"
     'créer un dosier avec le nom du mois et l'année en cours
     'si le mois change un autre dossier est créer
      Rep = Application.Proper(MonthName(Month(Date))) & " " & Year(Date)
      'gestion des erreurs
      On Error Resume Next
      'définition du chemin
      MkDir Chemin & Rep
      On Error GoTo 0
      Chemin = Chemin & Rep & "\"
      Sheets("Feuil1").Copy
      'copie de la feuille en ajoutant F devant le n° qui est en "C4" et +la date
      Fichier = Sheets("Feuil1").Range("C4") & " " & "F" & Format(Date, "ddmmyyyy") & ".Pdf"
      With ActiveWorkbook
      'code qui enregistre en .pdf
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Fichier, Quality:=xlQualityStandard, _
                              IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                              From:=1, To:=1, OpenAfterPublish:=False
        'ferme le classeur créer
       .Close savechanges:=False
       'retabli les arlertes windows
        Application.DisplayAlerts = True
        'message pour dire que le fichier a bien été enregistrer
        'que le chemin est bon
        MsgBox ("Enregistré dans le dossier -Factures-")
      End With
    End Sub

merci beaucoup a vous de vos idées

bonsoir a tous et et toutes

je pensais a tord qu'en modifiant le post ou j'avais trouvé ma réponse en publiant que celui-ci remonterai et non il faut une réponse que voila

le 1er code avais déja été revu brillamment https://forum.excel-pratique.com/excel/modifier-chemin-sauvegarde-sous-t84035.html

Par fred2406 et terminer par Eriiic

merci a eux 2

c'est ma comptable qui le demandes et depuis le code modifier avec fred2406 je créer manuellement les sous dossiers, en modifiant les chemins

le 2ème code est en liberté sur le net alors profitez en bien tous qui visitez le post

Bonjour,

perso je préfère le format 2016-12 qui permet d'avoir les répertoires dans l'ordre chronologique mais tu mets ce que tu veux.

En supposant que le mois soit celui en cours :

    chemin = "D:\Facturation-v1s\Factureseule\Devis\" & Format(Date, "yyyy-mm") & "\"
    If Dir(chemin, vbDirectory) = "" Then
        MkDir chemin
    End If

"D:\Facturation-v1s\Factureseule\Devis\" doit être existant.

eric

bonsoir Eriiic

merci de ta réponse le chemin exact est comme celui que tu as remis en bas de réponse soit

D:\Facturation-v1s\factureseule\devis

le format que tu propose me vas bien

a propos eriiic j'ai complètement laisser tombé le classeur que je t'ai proposer a modifier les code avec des selection

a mon avis il est complètement a revoir, mais si pour une aide sur le forum entre ( ) ça le fait bien au début

Pascal

bonsoir Eriiic

je viens de faire un test c'est bien vu la façon de le faire je n'y avais pas pensé mais il y a trop de dossiers

j'ai mis comme ceci dans un classeur d'essai pas dans le bon

Case "DEVIS"

Chemin = "C:\Facturation\Facture seule\devis\" & Format(Date, "yyyy-mm") & "\"

If Dir(Chemin, vbDirectory) = "" Then

MkDir Chemin

End If

mais ce me fait trop de dossiers

ca va bien dans

C:\Facturation\Facture seule\devis\

C:\Facturation\Facture seule\devis\2016-12\2016\décembre

mais le dernier 2016 est en trop

j'ai repris le 1er code de l'autre post et le c'est parfait merci beaucoup

C:\Facturation\Facture seule\devis\2016-12

Ce que je t'ai donné ne crée que "\2016-12\" et rien d'autre.

Si tu en rajoutes derrière forcément tu en auras plus.

eric

bonsoir ériiic

le premier point de sauvegarde étant résolu j'ai le reste du classeur qui aurais besoin du même traitement, mais la je pèche malgré ton code qui est parfait, la ou ca pèche c'est que les chemis sont dans un module et l'appel se fait ici

Dim NomDeFichier As String
  NomDeFichier = Sht.Range("DOC_TITRE").Value & " - " & Sht.Range("DOC_CLIENT").Value
  NomFicXL = NomDeFichier & ".xlsm"
  NomFicPDF = NomDeFichier & ".pdf"
  ' Pour vérification de la valeur
  Select Case UCase(Sht.Range("DOC_TYPE").Value)
    Case DOC_DEVIS:  CheminXL = DIR_DEVIS
    Case DOC_FACT:  CheminXL = DIR_FACT
    Case DOC_FACT_AQUI: CheminXL = DIR_FACT_AQUI
    Case DOC_FACT_ACC: CheminXL = DIR_FACT_ACC
    Case Else
      MsgBox "Erreur pour trouver le chemin de " & Sht.Range("D1").Value
      Exit Sub
  End Select

  CheminPDF = CheminXL & "PDF\"
  CheminXL = CheminXL & "\"

  ' Sauvegarder le classeur actif dans le chemin et le nom determiné
  ' FileFormat:=xlExcel8,
  ActiveWorkbook.SaveAs Filename:=DIR_WORKSPACE & CheminXL & NomFicXL, _
                         Password:="", WriteResPassword:="", _
                        ReadOnlyRecommended:=False, CreateBackup:=False
  

le module qui donne le lieu de sauvegarde de tous les documents

Public Const DIR_WORKSPACE As String = "C:\Facturation"
Public Const DIR_DEVIS As String = "\Devis"
Public Const DIR_FACT  As String = "\Facture"
Public Const DIR_FACT_AQUI As String = "\Factureacquittee"
Public Const DIR_FACT_ACC As String = "\Factureacompte"

je viens de voir qu'il manque un bout de code qui correspond a DOC_TYPE

Enum TypeDeDoc
    DOC_FACT = 0
    DOC_FACT_ACC = 1
    DOC_FACT_AQUI = 2
    DOC_DEVIS = 3
End Enum

si j'applique ton code ca vas pas avec vbdirectory en ne prenant que la fin

Chemin = "C:\Facturation\Facture seule\devis\" & Format(Date, "yyyy-mm") & "\"
    If Dir(Chemin, vbDirectory) = "" Then
        MkDir Chemin
    End If

CheminXL = DIR_DEVIS

et

Public Const DIR_DEVIS As String = "\Devis"

DIR_DEVIS ne doit plus être une constante mais une variable As String.

Que tu mets à la bonne valeur dans le

Case DOC_DEVIS

que tu écris sur plusieurs lignes.

Ou bien au même endroit tu calcules directement CheminXL et tu vires DIR_DEVIS partout.

bonjour Eriiic

merci de ta réponse, j'ai essayer de greffer ton code sur ces 2 lignes

CheminPDF = CheminXL & "PDF\"
  CheminXL = CheminXL & "\"

car ce sont elles qui donne le chemin vers les enregistrements

le code qui les concernent ce trouve dans l'userform "liste_boutons" puis le bouton enregistrer dans la base

les constantes sont dans le modules "M_constantes"

du moins su tu ouvre le classeur

en faisant un peu comme ceci que je n'ai pas essayer pour encore, mais il y d'autres constantes

Dim DIR_WORKSPACE As String, DIR_DEVIS As String, DIR_FACT As String, DIR_FACT_AQUI As String, DIR_FACT_ACC As String
workspace = "C:\Facturation"
DIR_DEVIS = "\Devis"
DIR_FACT = "\Facture"
DIR_FACT_AQUI = "\Factureacquittee"
DIR_FACT_ACC = "\Factureacompte"

écrit comme cela voici ce que ca donne dès le clic d'ouverture de l'userform de début

Bonjour,

Le message est clair pourtant.

Au besoin tu as même le bouton Aide.

Mais tu ne voulais des sous-dossiers que pour Devis...

eric

bonjour Eric

je n'ai jamais dit que les devis le 1er code je l'ai adapter car il est venu bien apres la création du fichier

le premier point de sauvegarde étant résolu j'ai le reste du classeur qui aurais besoin du même traitement, mais la je pèche

je n'y ai pris que l'exemple "devis" mais sur le reste c'est plus complexe voici comment l'autre a été utilisé

 If Dir(Chemin, vbDirectory) = "" Then
        MkDir Chemin
    End If
      Select Case F.Range("D1")
      Case "DEVIS"
        Chemin = "C:\Facturation\Facture seule\devis\" & Format(Date, "yyyy-mm") & "\"
    If Dir(Chemin, vbDirectory) = "" Then
        MkDir Chemin
    End If
      Case "FACTURE ACOMPTE"
        Chemin = "C:\Facturation\Facture seule\facture acompte\" & Format(Date, "yyyy-mm") & "\"
    If Dir(Chemin, vbDirectory) = "" Then
        MkDir Chemin
    End If
      Case "FACTURE ACQUITTEE"
        Chemin = "C:\Facturation\Facture seule\facture acquittee\" & Format(Date, "yyyy-mm") & "\"
    If Dir(Chemin, vbDirectory) = "" Then
        MkDir Chemin
    End If
      Case "FACTURE"
        Chemin = "C:\Facturation\Facture seule\factures\" & Format(Date, "yyyy-mm") & "\"
    If Dir(Chemin, vbDirectory) = "" Then
        MkDir Chemin
    End If
      Case Else
        MsgBox "Impossibilité de déterminer le chemin" & vbCr & "Fin du programme"
        End
      End Select

oui, et ??

Le reste est toujours valable :

Le message est clair pourtant.

Au besoin tu as même le bouton Aide.

Qu'est-ce que tu ne comprends pas dans le message d'erreur ?

Il te dit que tu ne peux pas initialiser une variable hors procédure, donc fait-le dans une procédure.

eric

bonjour eriiic

merci de ta réponse, voici le lien vers le message qui ne m'explique pas comment faire car viré une constante pour une publique

je ne le trouve nulle part

https://msdn.microsoft.com/fr-fr/library/office/gg264268(v=office.15).aspx

Qu'est-ce que tu ne comprends pas là dedans ?

C'est pourtant clair et difficile de le dire autrement.

A L'INTERIEUR D'UNE PROCEDURE !

C'est à dire pas en dehors : après un Sub et avant le End Sub

Sub truc()

toto="machin"

end sub

et ta question de départ l'est il me semble. Pour le B.A.BA sur les variables le net ne manque pas de ressources.

eric

bonjour Eriiic

merci de ta réponse et du besoin de mettre en résolu le post pour méconnaissance des variables, ce n'est le nombre d'étoiles sous le pseudo qui fait la connaissance du bionhomme