Autres VBA Dim Chemin As String - Choix de 2 chemins

Marine252 · 11 Mai 2023

Bonjour,

J'aurais besoin de vos lumières!!
Je souhaite que ma macro utilise 1 des 2 chemins indiqués pour enregistrer la feuille (afin qu'elle soit utilisable sur différents ordinateurs)
Auriez vous des propositions à me faire?
Evidemment "or" ne fonctionne pas....

Dim Chemin As String

Chemin = "C:\Users\OneDrive\Documents\Factures\2023\" Or "C:\Users\OneDrive\Documents\Factures\2000\"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\OneDrive\Documents\Factures\2023\" Or "C:\Users\OneDrive\Documents\Factures\2000\" & Fichier & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=2, To:=1, OpenAfterPublish:=False

Merciiiii d'avance!!

vgendron · 11 Mai 2023

Bonjour
??
c'est quoi la condition pour choisir le chemin 1 ou le chemin 2 ??

Marine252 · 11 Mai 2023

Que l'autre ne fonctionne pas?....

vgendron · 11 Mai 2023

c'est un peu léger..
ca veut dire quoi qu'il ne "fonctionne pas" ??

Marine252 · 11 Mai 2023

Oui je m'en rend bien compte, j'ai monté cette macro avec peu de connaissance de base et pleins d'informations piochées de parts et d'autres...
Je ne suis pas non plus certaine que cela puisse fonctionner mais je voudrais que si le chemin 1 n'aboutit pas, alors utiliser le chemin 2.
Navrée pour le langage probablement pas très adéquat...

vgendron · 11 Mai 2023

si on considère que "Ne fonctionne pas " veut dire "n'existe pas"

VB:

Public Function DossierExiste(MonDossier As String)
    If Len(Dir(MonDossier, vbDirectory)) > 0 Then
        DossierExiste = True
    Else
        DossierExiste = False
    End If
End Function

Sub Enregistrer()
Dim Chemin, Chemin1, Chemin2 As String
'écriture en dur des chemins possibles à tester
Chemin1 = "C:\Users\OneDrive\Documents\Factures\2023\"
Chemin2 = "C:\Users\OneDrive\Documents\Factures\2000\"

If DossierExiste(Chemin1) Then 'si le chemin 1 existe
    Chemin = Chemin1 'on utilise le chemin1
Else
    Chemin = Chemin2 'sinon on prend le chemin 2 ==> à noter ici qu'on a pas vérifié s'il existait aussi..??
End If

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Fichier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=2, To:=1, OpenAfterPublish:=False

End Sub

Marine252 · 11 Mai 2023

VB:

Sub ArchiverALL()

 ' Loop to cycle through each cell in the specified range.
   For Each x In Range("b24:b55")
      ' Change the text in the range to uppercase letters.
      x.Value = UCase(x.Value)
   Next

For Each Item In Sheets("FactureALL").Range("B24:B55")
If Item.Value = "" Then
Else

Dim dlg As Integer
With Feuil4
dlg = .Range("A" & .Rows.Count).End(xlUp).Row + 1
Ligne_origine = Item.Row

.Range("A" & dlg) = Sheets("FactureALL").Range("A17")

.Range("B" & dlg) = Sheets("FactureALL").Range("B20")

.Range("c" & dlg) = Sheets("FactureALL").Range("G12")
.Range("d" & dlg) = Sheets("FactureALL").Range("G13")
.Range("e" & dlg) = Sheets("FactureALL").Range("G14")
.Range("f" & dlg) = Sheets("FactureALL").Range("G15")
.Range("g" & dlg) = Sheets("FactureALL").Range("B21")
.Range("h" & dlg) = Sheets("FactureALL").Range("F56")
.Range("i" & dlg) = Sheets("FactureALL").Range("I59")
.Range("k" & dlg) = Sheets("FactureALL").Range("I57")
.Range("l" & dlg) = Sheets("FactureALL").Range("h20")
.Range("m" & dlg) = Sheets("FactureALL").Range("F60")
.Range("p" & dlg) = Sheets("FactureALL").Range("C21")
.Range("q" & dlg) = Sheets("FactureALL").Range("a21")
.Range("o" & dlg) = Sheets("FactureALL").Range("B" & Ligne_origine)
.Range("n" & dlg) = Sheets("FactureALL").Range("a" & Ligne_origine)
.Range("j" & dlg) = Sheets("FactureALL").Range("h" & Ligne_origine)
    '.Range("E" & dlg) = Sheets("Facture").Range("C3")
End With
End If
Next Item

With ActiveWorkbook.ActiveSheet
        On Error Resume Next
        For II = 2 To 2
          
          
          
        Next
        On Error GoTo 0
        .Range("A1").Select
    End With

   Public Function DossierExiste(MonDossier As String)
    If Len(Dir(MonDossier, vbDirectory)) > 0 Then
        DossierExiste = True
    Else
        DossierExiste = False
    End If
End Function
  Dim Chemin, Chemin1, Chemin2 As String
  Dim Fichier As String
 
        Fichier = "Facture_" & Sheets("FactureALL").Range("B21") & Sheets("FactureALL").Range("C21") & "_" & Sheets("FactureALL").Range("G12") & "_" & Sheets("FactureALL").Range("B20") & ".pdf"

Chemin1 = "C:\Users\OneDrive\Documents\Factures\2023\"
Chemin2 = "C:\Users\OneDrive\Documents\Factures\2000\"

If DossierExiste(Chemin1) Then 'si le chemin 1 existe
    Chemin = Chemin1 'on utilise le chemin1

    Else
    Chemin = Chemin2 'sinon on prend le chemin 2 ==> à noter ici qu'on a pas vérifié s'il existait aussi..??

End If

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Fichier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=2, To:=1, OpenAfterPublish:=False


' Message de confirmation

MsgBox ("Création du fichier PDF effectué" & vbCrLf & vbCrL&"Objectif Ma : 2827")
      
' Effacer Macro
With Sheets("FactureALL")
    .Range("B20,A24:A55,B24:B55,H57,k2").ClearContents
    End With
  
    With Sheets("FactureFR")
    .Range("B21") = .Range("B21") + 1
  
End With
ActiveSheet.Outline.ShowLevels RowLevels:=1

Range("B20").Select
    Sheets("FactureALL").Select
End Function

Voilà la macro entière, je n'arrive pas à intégrer sans ajouter de "End Sub"

vgendron · 11 Mai 2023

ha bah déjà. si tu espères ne pas devoir mettre de "end sub", c'est raté
un SUB est FORCEMENT associé à un END SUB

Sub ==> End Sub
Function ==> End function
If ==> End if
For ==>Next For

si tu postes ton code, utilise les balises (</> ) pour qu'il soit mis en forme==> il sera plus lisible
ensuite, il faudrait aussi mettre le fichier exemple (sans données confidentielles / remplacées par des données bidons)

Marine252 · 11 Mai 2023

vgendron à dit:
ha bah déjà. si tu espères ne pas devoir mettre de "end sub", c'est raté
un SUB est FORCEMENT associé à un END SUB

Sub ==> End Sub
Function ==> End function
If ==> End if
For ==>Next For

Oui ça je l'avais intégré toutefois impossible de la mettre à la fin.... ça me demande de le placer avant le public function

vgendron · 11 Mai 2023

normal: Sub et fonction sont deux structures différentes.. il faut donc en finir une avant de commencer l'autre..

vgendron · 11 Mai 2023

De ce que je devine, ca donnerait ce code

VB:

Sub ArchiverALL()
    Dim dlg As Integer
    Dim Chemin, Chemin1, Chemin2 As String
    Dim Fichier As String
    
    Chemin1 = "C:\Users\OneDrive\Documents\Factures\2023\"
    Chemin2 = "C:\Users\OneDrive\Documents\Factures\2000\"
        
    ' Loop to cycle through each cell in the specified range.
    For Each x In Range("b24:b55")
        ' Change the text in the range to uppercase letters.
        x.Value = UCase(x.Value)
    Next x
    
    For Each Item In Sheets("FactureALL").Range("B24:B55")
        If Item.Value <> "" Then
            With Feuil4
                dlg = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                Ligne_origine = Item.Row
                .Range("A" & dlg) = Sheets("FactureALL").Range("A17")
                .Range("B" & dlg) = Sheets("FactureALL").Range("B20")
                .Range("c" & dlg) = Sheets("FactureALL").Range("G12")
                .Range("d" & dlg) = Sheets("FactureALL").Range("G13")
                .Range("e" & dlg) = Sheets("FactureALL").Range("G14")
                .Range("f" & dlg) = Sheets("FactureALL").Range("G15")
                .Range("g" & dlg) = Sheets("FactureALL").Range("B21")
                .Range("h" & dlg) = Sheets("FactureALL").Range("F56")
                .Range("i" & dlg) = Sheets("FactureALL").Range("I59")
                .Range("k" & dlg) = Sheets("FactureALL").Range("I57")
                .Range("l" & dlg) = Sheets("FactureALL").Range("h20")
                .Range("m" & dlg) = Sheets("FactureALL").Range("F60")
                .Range("p" & dlg) = Sheets("FactureALL").Range("C21")
                .Range("q" & dlg) = Sheets("FactureALL").Range("a21")
                .Range("o" & dlg) = Sheets("FactureALL").Range("B" & Ligne_origine)
                .Range("n" & dlg) = Sheets("FactureALL").Range("a" & Ligne_origine)
                .Range("j" & dlg) = Sheets("FactureALL").Range("h" & Ligne_origine)
                '.Range("E" & dlg) = Sheets("Facture").Range("C3")
            End With
        End If
    Next Item
    
    
    If DossierExiste(Chemin1) Then 'appel de la fonction pour savoir si le chemin 1 existe
        Chemin = Chemin1 'on utilise le chemin1
    Else
        Chemin = Chemin2 'sinon on prend le chemin 2 ==> à noter ici qu'on a pas vérifié s'il existait aussi..??
    End If
    
    Fichier = "Facture_" & Sheets("FactureALL").Range("B21") & Sheets("FactureALL").Range("C21") & "_" & Sheets("FactureALL").Range("G12") & "_" & Sheets("FactureALL").Range("B20") & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Fichier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=2, To:=1, OpenAfterPublish:=False
    
    ' Message de confirmation
    MsgBox ("Création du fichier PDF effectué" & vbCrLf & vbCrL & "Objectif Ma : 2827")
    
    ' Effacer Macro
    With Sheets("FactureALL")
        .Range("B20,A24:A55,B24:B55,H57,k2").ClearContents
    End With
    
    With Sheets("FactureFR")
        .Range("B21") = .Range("B21") + 1
    End With
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    
    Range("B20").Select
    Sheets("FactureALL").Select
End Sub

Public Function DossierExiste(MonDossier As String) 'définition de la function'
    If Len(Dir(MonDossier, vbDirectory)) > 0 Then
        DossierExiste = True
    Else
        DossierExiste = False
    End If
End Function

Marine252 · 11 Mai 2023

Tu es fantastique!!!!
Merci 1000000x!!!!

Autres VBA Dim Chemin As String - Choix de 2 chemins

Marine252

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Marine252

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Marine252

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Marine252

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Marine252

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

Marine252

XLDnaute Nouveau

Discussions similaires