Bonjour à tous,



Après plusieurs essais infructueux, je me décide à venir chercher un peu plus d'aide.

J'ai besoin de récupérer dans un fichier excel le contenu d'une cellule pour ensuite le définir en tant que nom de fichier.

Le but serait donc :

-Récupérer le contenu de la cellule,

-Le définir en tant que nom de fichier dans une boite de dialogue, et le laisser modifiable pour que l'utilisateur puisse interagir, ou l'afficher dans le MsgBox pour que l'utilisateur puisse le copier coller

-Enregistrer sous : - soit dans un dossier défini par l'utilisateur, (avec un bouton parcourir mais compliqué à faire il me semble)

-soit sur le bureau si trop compliqué.

Je vous mets mon bout de code confectionné à l'aide de différent tutos/codes récupérés à droite à gauche





Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
 
 
Sub ENREGISTRER() 'save as
Dim swApp As SldWorks.SldWorks
Dim SWmoddoc As SldWorks.ModelDoc2
Dim CODE As String
Dim nErrors             As Long
Dim nWarnings           As Long
 
 
Set swApp = Application.SldWorks
Set SWmoddoc = swApp.ActiveDoc
 
PathName = UCase(SWmoddoc.GetPathName)
 
If Right(PathName, 3) = "DRW" Then
    MesgBOX = MsgBox("Macro à lancer uniquement depuis une pièce ou un assemblage", vbMsgBoxSetForeground, "Enregistrer-sous")
    Exit Sub
    ElseIf Right(PathName, 3) = "PRT" Then
        DRWPath = Replace(PathName, "PRT", "DRW")
    ElseIf Right(PathName, 3) = "ASM" Then
        DRWPath = Replace(PathName, "ASM", "DRW")
End If
 
FilePath = Left(PathName, InStrRev(PathName, "\"))
 
FileName = Right(PathName, Len(PathName) - InStrRev(PathName, "\"))
 
 
RET = MsgBox("Avez vous terminé le paramétrage de votre pièce ?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Enregistrer-sous")
 
If RET = vbCancel Then End
Do
    'on récupère le TITRE3
    NewName = SWmoddoc.CustomInfo("TITRE3")
    'on l'affiche
    'RET = MsgBox(NewName, vbMsgBoxSetForeground)
    NewName = InputBox("Validez ou modifiez le nom de la pièce" & vbNewLine & vbNewLine, "Définition du nom", NewName)
 
    If StrPtr(NewName) = 0 Then
        MsgBox "Procédure annulée"
 
        Exit Sub
    End If
 
    Do While InStr(NewName, Chr(34)) > 0 Or InStr(NewName, "\") > 0 Or InStr(NewName, "/") > 0 _
    Or InStr(NewName, ":") > 0 Or InStr(NewName, "*") > 0 Or InStr(NewName, "?") > 0 Or InStr(NewName, "<") > 0 Or InStr(NewName, ">") > 0 Or InStr(NewName, "|") > 0
 
        NewName = InputBox("Attention, le nom contient au moins un des caractère interdits \/:*?""<>|" & vbNewLine & vbNewLine & _
        "Merci d'indiquer le nouveau nom : ", "Enregistrer-sous", NewName)
    Loop
 
Loop While NewName = ""
 
Do
    FilePath = InputBox("Dans quel dossier voulez vous enregistrer la pièce ?", "Enregistrer-sous", FilePath)
    If StrPtr(FilePath) = 0 Then
        MsgBox "Procédure annulée"
        Exit Sub
    End If
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
 
    If Dir$(FilePath) <> "" Then
        EXISTE = 1
    Else: MsgBox "Le répertoire n'existe pas, merci de le créer"
    Debug.Print Dir$(FilePath)
    End If
 
Loop While EXISTE <> 1
 
Set swModel = swApp.ActivateDoc2(PathName, False, nErrors)
 
If (SWmoddoc.GetType = swDocASSEMBLY) Then
 
    SWmoddoc.SaveAs (FilePath + NewName + ".SLDASM")
ElseIf (SWmoddoc.GetType = swDocPART) Then
 
     SWmoddoc.SaveAs (FilePath + NewName + ".SLDPRT")
End If
 
End Sub
Merci d'avance !