Mes questions
Vous n'avez posé aucune question.
Gagnez des points en posant votre question !
Mes contributions
Vous n'avez répondu à aucune question.
Vous pouvez gagner des points en répondant à des questions !
coin37coin

macro DXF PDF

coin37coin
1756
Vues

Hello.

 

J'ai une macro qui se déroule sans accro ... mais où rien ne se passe. Je ne comprends pas bien pourquoi et où ça coince. Si quelqu'un à une idée ?

J'ai mis des commentaires pour expliquer ce que je tente d'y faire. Dans l'idée, c'est d'enregistrer chaques feuilles de mon DRW en DXF et en PDF dans le bon nom au bon repertoire.

 

 

Sub Enregistrer()
Dim swapp As SldWorks.SldWorks
Dim swdoc As SldWorks.ModelDoc2
Dim Swdraw As SldWorks.ModelDoc
Dim swSheet As SldWorks.Sheet
Dim vSheetNames As Variant
Dim Nbfeuille As Variant
Set swapp = Application.SldWorks
Set swdoc = swapp.ActiveDoc
Set Swdraw = swdoc
Set swSheet = Swdraw.GetCurrentSheet
'Message de confirmation
ret = MsgBox("voulez-vous convertir cette mise en plan en DXF et PDF ?", vbOKCancel + vbExclamation + vbMsgBoxSetForeground + vbSystemModal, "Conversion Laser")
If ret = vbCancel Then End
'Enregistrement nouveau nom
Do
 newname = InputBox("Merci d'indiquer le nouveau nom:", "blabla", newname)
 If StrPtr(newname) = 0 Then
 MsgBox "procédure annulée"
 Exit Sub
 End If
'Verification caractere interdit Windows
Do While InStr(newname, "/") > 0 Or InStr(newname, "*") > 0 Or InStr(newname, "?") > 0 Or InStr(newname, "<") > 0 Or InStr(newnam, ">") > 0 Or InStr(newnam, "!") > 0
 newname = InputBox("Attention, le nom contient au moins un des caractère interdits \/:*?""<>!" & vbNewLine & vbNewLine & "Merci d'indiquer le nouveau nom: ", "enregistrer-sous par LPR", newname)
 Loop
 Loop While newname = " "
'Dossier d'enregistrement
Do
 FilePath = InputBox("Indiquez le chemin d'accés", "dossier enregistrement", FilePath)
 If StrPtr(FilePath) = 0 Then
 MsgBox "procédure annulée"
 Exit Sub
End If
'Ajout du \ à la fin du nom de dossier
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
'Indique le nombre de feuille
Nbfeuille = swdoc.GetSheetCount
For i = 0 To Nbfeuille
    swdoc.SheetPrevious
    Next i
    'passage à la feuille suivante si < au nombre total
    For i = 0 To varSheetCount - 1
    If i <> 0 Then
    swmodel.SheetNext
    End If
'Enregistrement en DXF et PDF
swdoc.SaveAs (FilePath + newname + "_" + i + ".dxf")
swdoc.SaveAs (FilePath + newname + "_" + i + ".pdf")
Next i
End Sub

Il y a 2 années
SOLIDWORKS
.PL
Meilleure réponse

Salut,

Pour le débogage, voir ce lien :

Voir ce lien : http://www.tomshardware.fr/forum/id-1348092/tutoriel-excel-macro-vba-debogage.html

Essaye de faire un point d'arrêt pour les lignes :

 

swdoc.SaveAs (FilePath + newname + "_" + i + ".dxf")
swdoc.SaveAs (FilePath + newname + "_" + i + ".pdf")

 

Le programme y passe bien ?

 

Si non, regarde pourquoi.

 

Si oui, fais un debug.print juste avant les lignes pour voir ce qu'elles contiennent :

debug.print FilePath + newname + "_" + i + ".dxf"

Il y a 2 années
.PL

Salut,

Pour le débogage, voir ce lien :

Voir ce lien : http://www.tomshardware.fr/forum/id-1348092/tutoriel-excel-macro-vba-debogage.html

Essaye de faire un point d'arrêt pour les lignes :

 

swdoc.SaveAs (FilePath + newname + "_" + i + ".dxf")
swdoc.SaveAs (FilePath + newname + "_" + i + ".pdf")

 

Le programme y passe bien ?

 

Si non, regarde pourquoi.

 

Si oui, fais un debug.print juste avant les lignes pour voir ce qu'elles contiennent :

debug.print FilePath + newname + "_" + i + ".dxf"

Il y a 2 années
Joss.G

N'y connaissant pas grand-chose en création de macro, j'ai seulement trouvé une autre macro qui peut faire ce que vous chercher à réaliser... Si ça peut vous aider ?

 

 

Il y a 2 années
.PL

J'ai déjà proposé deux macros faisant ceci dans sa dernière question, mais il prefère faire se propre macro :

http://www.lynkoa.com/forum/3d/trouver-une-feuille-mep-en-vba-sous-solid...

Il y a 2 années
Joss.G

Autant pour moi,

Je ne peux pas t'aider alors, bonne chance ;)

Cdt,

Joss

Il y a 2 années

Encore quelques bug, mais j'approche du but ultime (haaaa !)

 

Bref, merci pour les info sur la résolution de bug

Il y a 2 années