Macro qui permet la conversiton SLDDRW en PDF/ DWG avec checkbox et userfrom

Bonjour à tous,

Je suis actuellement entrain de modifier une macro existante afin quel s'adapte à mes contraintes.

La macro existante permettez la conversion de de fichier SLDDRW en PDF et DXF avec le choix du dossier source et de destination et modifier le nom suivant la révision du plan. 

Bref...

Pour mon cas j'aimerai quel fasse la conversion en PDF et DWG sans se soucier de la révision mais qu'on puisse avoir un choix (genre checkbox entre PDF et DWG.

J'ai réussi à faire certenaine modification (comme enlever tous ce qui à un rapport avec la révision) et modifier DXF en DWG et inserer mes chexbox sur le Userfrom.

Mais parcontre pour le codage des checkbox j'ai un souci (sachant que je n'ai pas beaucoup de bouteille dans VBA j'ai bien essayé quelque chose mais bon).

Si vous avez une petit idée ?

Merci à vous :)

Voici une partie du code:

Private Sub FiltreBox_Change()
    StartConvert.Enabled = False
    TextSource.Caption = "Valider le répertoire source"
    TextSource.ForeColor = RGB(255, 0, 0)
    OkSource = False
    CheckSource.Enabled = True
End Sub


Private Sub SourceBox_Change()
    StartConvert.Enabled = False
    TextSource.Caption = "Valider le répertoire source"
    TextSource.ForeColor = RGB(255, 0, 0)
    OkSource = False
    CheckSource.Enabled = True
End Sub
Private Sub CheckBox1_Click()

End Sub

Private Sub CheckBox2_Click()

End Sub

Private Sub StartConvert_Click()
Set swApp = Application.SldWorks

TimeDebut = Timer
NombreFichierDestination = 0
NomFichier = Dir(PathDepart & FiltreBox.Value & ".SLDDRW")
' Commence la boucle

    Do While NomFichier <> ""
        NombreFichierDestination = NombreFichierDestination + 1
        Avancement.Caption = "Traitement du fichier " & NombreFichierDestination & " / " & NombreFichierSource & " : " & NomFichier
        SaveDir.Repaint
        NomFichierSansExtension = Left(NomFichier, Len(NomFichier) - 7)
        'Ouverture du fichier
        Set Part = swApp.OpenDoc6(PathDepart & NomFichier, 3, 0, "", longstatus, longwarnings)
        swApp.OpenDoc6 PathDepart & NomFichier, 3, 0, "", longstatus, longwarnings
        Set Part = swApp.ActivateDoc2(NomFichier, False, longstatus)
        Set swCustPrpMgr = Part.Extension.CustomPropertyManager("")
        'Création du fichier pdf
        If CheckBox1.Value = True Then
        Part.Extension.SaveAs PathArrivee & NomFichierSansExtension & ".pdf", 0, 0, Nothing, longstatus, longwarnings
       End If
        'Création du fichier dwg
        If CheckBox1.Value = True Then
        Part.Extension.SaveAs PathArrivee & NomFichierSansExtension & ".dwg", 0, 0, Nothing, longstatus, longwarnings
        End If
        'Fermeture du plan
        Set Part = Nothing
        swApp.CloseDoc NomFichier

        NomFichier = Dir    ' Extrait l'entrée suivante.
    Loop

StartConvert.Enabled = False
TimeFin = Timer

Avancement.Caption = "Opération terminée. " & NombreFichierDestination & " / " & NombreFichierSource & " fichier(s) traités. Temps écoulé: " & TimeSerial(0, 0, TimeFin - TimeDebut)

 

End Sub

Private Sub UserForm_Initialize()
    OkSource = False
    OkSource = False
    StartConvert.Enabled = False
    FiltreBox.Value = "*"
    TextSource.Caption = "Introduire et valider le répertoire source"
    TextSource.ForeColor = RGB(255, 0, 0)
    TextDestination.Caption = "Introduire et valider le répertoire destination"
    TextDestination.ForeColor = RGB(255, 0, 0)
    SourceBox.Value = "Z:\affaires"
    DestinationBox.Value = "Z:\affaires"
    Avancement.Caption = ""
End Sub

Salut,

Précise les rôles des CheckBox1 et CheckBox2 et ce que tu souhaites en faire.

Le principe de fonctionnement d'une checkbox :

Elle possède une propriété Value qui varie entre True et False.

Pour utiliser ce changement il faut utiliser l'évennement Click.

Exemple :

Private Sub CheckBox1_Click()
     If CheckBox1.Value = True Then
          MsgBox ("Action si vrai")
     ElseIf CheckBox1.Value = False Then
          MsgBox ("Action si faux")
     End If

End Sub

 

3 « J'aime »

D'accord, merci,

Je vais essayé. je te tien au jus ;)

 

1 « J'aime »

ça marche c'est super!

encore une autre chose,

Je souhaiterai mettre une msgbox erreur si on ne coche aucune checkbox.

Je pensais écrire ceci:

Sub msgbox()
If CheckBox1.Value = False Then
ElseIf CheckBox2.Value = False Then
Select Case msgbox("Merci de choisir une conversion SVP!", vbExclamation, "Erreur conversion")
End Sub

1 « J'aime »

Pour ton code :

Sub msgbox()
     If CheckBox1.Value = False and CheckBox2.Value = False Then
          Msgbox("Merci de choisir une conversion SVP!", vbExclamation, "Erreur conversion")
     End If
End Sub

 

Mais en programmation, si cela est possible,  il est toujours mieux de ne pas permettre à l'utilisateur de faire une betise au lieu de lui dire qu'il en a fait une.

C'est pourquoi je pense que tu as un bouton dans ton Userform qui lance la conversion. Imaginons que tu l'as nommé Bouton_Lancement.

Private Sub CheckBox1_Click() 'Cette sub existe déjà donc rajoute y le code ci dessous

     If CheckBox1.Value = False and CheckBox2.Value = False Then
          Bouton_Lancement.Visible = False    
     Else If CheckBox1.Value = True Or CheckBox2.Value =  True Then
          Bouton_Lancement.Visible = True
     End If

End Sub

Puis fait de même avec la fonction de l'évennement CheckBox2_Click

Ce code te permettra de rendre invisible le bouton de lancement donc impossible de continuer. Il ne sera donc pas nécessaire de réprimender l'utilisateur ;-)

En espérant t'avoir aider.

3 « J'aime »

Salut,

As-tu le lien pour télécharger la macro de base stp ? 

Merci d'avance

Merci pour ta réponse,

Je regarde ça et je te dis si ça fonctionne.

 

RazFlash: je recherche et si je la retrouve je te donne le lien.

Il me met une erreur quand je met la seconde solution.

"Erreur de compilation:

Cette instruction doit être la première de la ligne"

la ligne -> "Else If CheckBox1.Value = True or CheckBox2.Value =  True Then" est écrite en rouge

Razflash:

Je n'ai pas trouvé le lien d'origine ...

Mais j'ai le fichier d'origine.

je l'ai mis en pièce jointe.


savediraspdf_v1.1.zip

Erreur d'espace :

Private Sub CheckBox1_Click() 'Cette sub existe déjà donc rajoute y le code ci dessous

     If CheckBox1.Value = False and CheckBox2.Value = False Then
          Bouton_Lancement.Visible = False    
     ElseIf CheckBox1.Value = True Or CheckBox2.Value =  True Then
          Bouton_Lancement.Visible = True
     End If

End Sub

Merci pour le fichier ! 

Dsl du retour.

 

Merci ça marche très bien.

 

J'aurai d'autres modifications encore à faire je pense surtout au niveau du dossier source et du fichier de destination où je souhaiterai avoir un bouton parcourir au lieu de coller le lien, mais je le ferai plus tard.

 

Merci à toi remrem.

Salut,

Mais de rien...

N'hésite pas à poser d'autres questions pour tes améliorations.

Bonne journée.