Automatiser la création d'un dossier chez différents utilisateurs

Bonjour,

Je vais avoir une centaine d'utilisateurs, parfois débutants dans l'utilisation d'Excel.

Serait-il possible de créer automatiquement, sur clique "PDF" ou "STAT", un dossier nommer "PERFS_CHALLENGE_SPORTIF" sur le bureau de chaque utilisateur (dont le chemin d'accès est forcément différent sur chaque PC).

BsAlv m'a créé une boîte de dialogue sur clique "PDF" ou "STAT", qui renseigne le Username (j'ai créé volontairement une erreur de username pour mieux illustrer mon exemple) :

Private Sub Ok_Click()
     Dim FileN$, Maintenant, AppShell

     Maintenant = Format(Now, "yyyymmdd_hhmmss")
     Select Case Application.UserName        'dépendant de l'username de votre ordinateur, on choisit un autre dossier
          Case "BSA":                        'username "BsAlv"
               FileN = ThisWorkbook.Path & "\@_" & Maintenant & ".pdf"     'chemin pour BsAlv
          Case "Seb DORV"                    'username ordinateur vodoraix à la maison
               FileN = "C:\Excel\@_" & Maintenant & ".pdf"     'A remplacer par le nom et chemin de votre fichier cible
          Case "DORVEAUX Sebastien"          'username ordinateur vodoraix àu travail
               FileN = "\\docs1-cp-marseille\utilisateurs\sebastien.dorveaux\Bureau\Tableaux_EXCEL\@_" & Maintenant & ".pdf"
          Case Else
               MsgBox "votre username = " & Application.UserName & " n'est pas reconnu", vbExclamation: Unload Me: Exit Sub
     End Select

     Range("tabel1").Parent.Unprotect MdP
     'Me.Hide
     Masquer
     Unload Me

     With Range("tabel1").ListObject.Range
          '  .Columns(1).BorderAround LineStyle:=xlContinuous, Weight:=xlThick
          If Cnt <> 1 Then MsgBox "seulement 1 coche", vbExclamation: GoTo 1
          Application.PrintCommunication = False
          With .Parent.PageSetup
               .LeftMargin = Application.CentimetersToPoints(1)
               .RightMargin = Application.CentimetersToPoints(1)
               .TopMargin = Application.CentimetersToPoints(1)
               .BottomMargin = Application.CentimetersToPoints(1)
               .HeaderMargin = Application.InchesToPoints(0)
               .FooterMargin = Application.InchesToPoints(0)
               .Zoom = False
               .FitToPagesWide = 1
               .FitToPagesTall = 6
          End With
          Application.PrintCommunication = True
          Range("pdf").Value = 1
          .Rows(1).EntireRow.Hidden = True   'cacher headerrowrange
          '.Columns(1).EntireColumn.Hidden = True     'cacher headerrowrange
Debug.Print .Offset(-1).Resize(.Rows.Count + 1).Address
          With .Offset(-1).Resize(.Rows.Count + 2)
               'MsgBox .Address
               '.PrintPreview
               FileN = Replace(Replace(FileN, "@", Nom_Epreuve), vbLf, "_")
               .ExportAsFixedFormat Type:=xlTypePDF, Filename:=FileN, OpenAfterPublish:=True
          End With

          Shell_LaunchWindowsExplorer Left(FileN, InStrRev(FileN, "\") - 1)

1:
          .Rows(1).EntireRow.Hidden = False  'montrer headerrowrange
          Range("pdf").ClearContents
          '.AutoFilter
          .EntireColumn.Hidden = False
          Application.GoTo .Parent.Range("A1")
     End With
     Proteger

End Sub

A ce moment-là, serait-il possible de récupérer automatiquement le username et l'envoyer dans le VBA sans être obligé de le saisir.

Mais aussi, et là c'est peut-être beaucoup plus compliqué, de créer un chemin d'accès automatisé sans devoir renseigner à chaque fois l'adresse comme par exemple,

FileN = "\\docs1-cp-marseille\utilisateurs\sebastien.dorveaux\Bureau\Tableaux_EXCEL\@_" & Maintenant & ".pdf"

Possible ou impossible ?

En tout cas merci pour le temps que vous prenez pour nous autres débutants :-)))))

Bonne journée :-)))))))))))))))

re,

n'est-ce pas plus de sauvegarder ce pdf dans le même dossier que le fichier "xlsb" oubien dans oubien "documents" ou "temp", les 2 dossiers qui sont connu sans intervention ?

MsgBox "Temp : " & Environ("temp") & vbLf & vbLf & "Documents : " & CreateObject("WScript.Shell").SpecialFolders("MyDocuments")

Bonjour Bart' et merci bcp,

Oui, oui et oui :-)))))))))))))))

Tu as raison même si je préfère dans le dossier "xlsb" ;-)))))) Mais, certains utilisateurs risquent de déplacer le fichier Excel, directement sur leur bureau donc =====>

"Temp", je ne pense pas qu'on y ait accès car sur nos ordis du travail, bcp, bcp de dossiers sont inaccessibles.

Et pour "Documents", je peux tester mardi qd je reprends le travail si dans ce dossier c'est plus facile ;-)))))

Et tu pourras voir, stp, qu'il y ait un message :" Tous vos PDF sont sauvegardés dans votre dossier "Documents" "

Et même dans l'absolue, je pense surtout aux supers débutants, de créer automatiquement un raccourci du dossier "Documents" sur le bureau de tout le monde ;-))))))

C'est possible aussi, que le dossier s'ouvre comme d'hab, qd on clique sur "PDF" ou "STAT" ?

Qu'en penses-tu ?

MErci encore :-)))))))))))))))))

Hello,

Une proposition pour la création du dossier sur le bureau :

Sub dossier bureau()
    Dim cheminBureau As String
    Dim cheminDossier As String

    ' chemin bureau utilisateur
    cheminBureau = Environ("USERPROFILE") & "\Bureau"
    cheminDossier = cheminBureau & "\PERFS_CHALLENGE_SPORTIF"

    ' Vérifier si le dossier existe déjà
    If Dir(cheminDossier, vbDirectory) = "" Then
        ' Créer le dossier
        MkDir cheminDossier
    Else

    End If

    ' Ici, tu mets ta macro pour l’enregistrement du pdf
End Sub

@+

Bonjour et merci bcp Baroute78 :-))))))))))))))))))))

Je vais essayer de voir entre ta proposition et celle de BsAlv....

En tout cas, je te tiens au courant

Encore merci :-)))))))))))))))))))))))))))))))

Bonne journée :-))))))))))))))))))