Macro pour enregistrer une liste de mise en plan en PDF

vos questions concernant les API SolidWorks

Macro pour enregistrer une liste de mise en plan en PDF

Messagepar BAHI » Sam 01 Juin 2013, 15:14

Bonjour,

Je suis un novice en macro c'est pour cela que je vous envoi cette demande.
J'ai des carnet à faire avec plus de 50 plans dedans et je dois en faire des PDF.
Ce que j'aimerai c'est une macro dans la laquelle je donnerai le liens vers le dossier
où sont mes plans et ensuite elle m'ouvrira mes plans une par une, les enregistrera et les fermera.
J'ai essayé de la faire mes j'ai pas réussi à faire tout se que je voulais :(
Donc si vous pouvez m'aider sa serai sympa.
Merci
BAHI
Ewok SolidWorks
 
Messages: 1
Inscription: Jeu 30 Mai 2013, 21:48

Re: Macro pour enregistrer une liste de mise en plan en PDF

Messagepar mini_shaker » Lun 22 Juil 2013, 9:17

salut,

j'avais une macro qui faisait ca mais sous vb6, c'est vraiment fouilli mais c'est fonctionnel:

Code: Tout sélectionner
'Déclaration de l'API
Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
                   "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
 'Structure du fichier
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
 'Constantes
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
 
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0

'-------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Public MonDoss As String, TestF As Boolean, Ouvrir As Boolean
Public Impr As Boolean, DossDest As String

Public TypeFich As String, NbTy As Integer

Dim i As Long
Dim NomPDF As String

Dim FL1 As Worksheet, Cell As Range, NoCol As Integer
Dim NoLig As Long, DerLig As Long, Var As Variant

Dim swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2

Dim theFolder As String, FichieR As String, myError As Long, myWarnings As Long
Dim boolstatus As Boolean

'---------------------------------------------------------------------------------------------------------------------------
   
    Dim lErrors As Long
    Dim Filename As String
    Dim sChemin As String
   
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hWnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
   
'---------------------------------------------------------------------------------------------------------------------------
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'constantes pour les temporisations
Private Const maxTime = 3 ' en secondes
Private Const sleepTime = 350 ' en millisecondes

Dim c As Long
'-------------------------------------------------------------------------------------------------------------------------------------------
 
 
Sub main()


'selection d'un fichier excel ******************************************************************************************************

Dim OuvrirUnFichier As String
Dim Handle As Long, Titre As String, NomFich As String, ChemiN As String, TypeRetour As Byte, TitreFiltre As String, TypeFichier As String, RepParDefaut As String

                               
 'OuvrirUnFichier est la fonction a utiliser dans votre formulaire pour ouvrir _
la boîte de dialogue de sélection d'un fichier.
 'Explication des paramètres
    'Handle = le handle de la fenêtre (Me.Hwnd)
    'Titre = Titre de la boîte de dialogue
    'TypeRetour (Définit la valeur, de type String, renvoyée par la fonction)
        '1 = Chemin complet + Nom du fichier
        '2 = Nom fichier seulement
    'TitreFiltre = Titre du filtre
        'Exemple: Fichier Access
        'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    'TypeFichier = Extention du fichier (Sans le .)
        'Exemple: MDB
        'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    'RepParDefaut = Répertoire d'ouverture par defaut
        'Exemple: C:\windows\system32
        'Si vous laissé l'argument vide, par defaut il se place dans le répertoire de votre application
 
Dim StructFile As OPENFILENAME
Dim sFiltre As String

'Construction du filtre en fonction des arguments spécifiés
If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
  sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Fichiers xls (*.xls)" & Chr$(0) & "*.xls" & Chr$(0)
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)

 ' Configuration de la boîte de dialogue
  With StructFile
    .lStructSize = Len(StructFile) ' Initialisation de la grosseur de la structure
    .hwndOwner = Handle ' Identification du handle de la fenêtre
    .lpstrFilter = sFiltre ' Application du filtre
    .lpstrFile = String$(254, vbNullChar) ' Initialisation du fichier '0' x 254
    .nMaxFile = 254 ' Taille maximale du fichier
    .lpstrFileTitle = String$(254, vbNullChar) ' Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 254  ' Taille maximale du nom du fichier
    .lpstrTitle = Titre ' Titre de la boîte de dialogue
    .flags = OFN_HIDEREADONLY  ' Option de la boite de dialogue
    If ((IsNull(RepParDefaut)) Or (RepParDefaut = "")) Then
        RepParDefaut = "M:\"
        PathStripPath (RepParDefaut)
        .lpstrInitialDir = RepParDefaut
        Else: .lpstrInitialDir = RepParDefaut
    End If
  End With

 NomFich = GetOpenFileName(StructFile)
 
ChemiN = Trim$(Left(StructFile.lpstrFile, InStr(StructFile.lpstrFile, vbNullChar) - 1))

Debug.Print ChemiN

'recherche dans le tableur excel ******************************************************************************************************

Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel
Dim swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, dbvalue As String


Set appExcel = CreateObject("Excel.Application") 'Ouverture d'Excel
Set wbExcel = appExcel.Workbooks.Open(ChemiN)

    'Instance de la feuille qui permet d'utiliser FL1 partout dans
    'le code à la place du nom de la feuille
    Set FL1 = Worksheets("Feuil1")
 
    'Détermine la dernière ligne renseignée de la feuille de calculs
    '(Voir explication sur l'utilisation de Split en bas de cette discussion)
   
    DerLig = Range("A5").End(xlDown).Row
    'DerLig = Split(FL1.UsedRange.Address, "$")(4)
 
   
        'Fixe le N° de la colonne à lire
    NoCol = 1
 
    'Utilisation du N° de ligne dans une boucle For ... Next
    For NoLig = 5 To DerLig
        Var = FL1.Cells(NoLig, NoCol)
 
        'Pour tester : Affiche les variables dans la fenêtre Exécution de VBA
        Debug.Print Var
       
'impression ***************************************************************************************************************************
       
Dim pdf As PDFCreator.clsPDFCreator
Dim ws       As Worksheet
Dim closepdf As Boolean
Dim i        As Integer
Dim rc       As Long
Set pdf = New PDFCreator.clsPDFCreator
closepdf = pdf.cStart("/NoProcessingAtStartup")
pdf.cDefaultPrinter = True
pdf.cOption("UseAutosave") = 0
pdf.cOption("UseAutosaveDirectory") = 0
pdf.cOption("AutosaveDirectory") = Var
pdf.cOption("AutosaveFilename") = Var
pdf.cOption("AutosaveFormat") = 0

   Filename = theFolder & Var & ".PDF"
    sChemin = Left(Filename, InStrRev(Filename, "\"))
    lErrors = ShellExecute(0, "print", Filename, vbNullString, sChemin, 1)

'Debug.Print "impression"
     
'temporisation ***************************************************************************************************************************
 
  c = 0
  Do While (pdf.cOutputFilename = "") And (c < (maxTime * 1000 / sleepTime))
 
  c = c + 1
 
  Sleep 500
 
  Loop
  Next
 
'fermeture excel ***************************************************************************************************************************
wbExcel.Close 'Fermeture du classeur Excel
appExcel.Quit 'Fermeture de l'application Excel

'Désallocation mémoire
Set wsExcel = Nothing
Set wbExcel = Nothing
Set appExcel = Nothing

Shell ("taskkill /F /IM Excel.exe")
Debug.Print "Excel fermé"

End Sub
mini_shaker
Ewok SolidWorks
 
Messages: 34
Inscription: Jeu 11 Déc 2008, 9:04
Localisation: hazebrouck (nord)

Re: Macro pour enregistrer une liste de mise en plan en PDF

Messagepar CLLC » Mer 07 Jan 2015, 15:42

Bonjour

Peut être un peu tard mais si ça peut servir:


Save Directory As Pdf V1.1
Par Marco Ruggiero
Modifié le: novembre 04,2009

Condition préalable:
Effectuer un essai avec un répertoire contenant 2 ou 3 plans.

Post-condition:
Ouverture et sauvegarde en pdf de tous les plans contenu dans un répertoire. Le répertoire source et celui de déstination sont demandés au démarrage. Le nom du fichier pdf est composé comme suit: NomFichier.pdf. Si une propriété "Révision" est présente le fichier est nommé Nomfichier_Révision.pdf

Possibilité de filtrer les fichiers
Fichiers joints
SaveDirAsPdf_V1.1.ZIP
(22.51 Kio) Téléchargé 446 fois
CLLC
Padawan SolidWorks
 
Messages: 68
Inscription: Ven 06 Juin 2014, 9:42

Re: Macro pour enregistrer une liste de mise en plan en PDF

Messagepar kmailla » Mer 18 Mar 2015, 14:16

Juste énorme !

Un grand merci ça fonctionne à merveille :) On peut maintenant boire un café pendant qu'un dossier de plus de 100 plans s'enregistre en pdf

Je suis sous Solidworks 2015 SP1.1
kmailla
Ewok SolidWorks
 
Messages: 10
Inscription: Mer 26 Nov 2014, 10:32


Retourner vers Questions générales sur les API

 


  • Articles en relation
    Réponses
    Vus
    Dernier message

Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 6 invités

banniere