SBL0
Messages postés1Date d'inscriptionvendredi 3 novembre 2017StatutMembreDernière intervention 3 novembre 2017
-
Modifié le 3 nov. 2017 à 15:58
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018
-
6 nov. 2017 à 11:13
Bonjour à tous,
J'essai de créer un programme afin de pouvoir imprimer des dossiers de plusieurs pdf.
Une première boucle a été créée afin de gérer l’entièreté des lignes.
Il s'organise en trois étapes :
-1ère étape vérifier si le pdf du plan, correspondant à l'ordre de fabrication, (en colonne A et B de la feuille) est existant dans le dossier spécifié. Si oui, imprimer les 3 documents.
-2ème étape, si pdf du plan non présent, vérifier s'il ne fait pas partie des plan générique (la liste étant en colonne G et H de la feuille).
-3ème étape, si pas de plan et pas de plan générique, il faut envoyer l'ordre de fabrication par mail (compiler l'ensemble des OF sans plan dans un seul mail).
Sans prendre en compte l'étape 2, tout se passer bien, mais je n'arrive pas à intégrer cette étape.
ci dessous le code,
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
Public Function FichierExiste(MonFichier As String)
'par Excel-Malin.com ( [http://excel-malin.com] )
If Len(Dir(MonFichier)) > 0 Then
FichierExiste = True
Else
FichierExiste = False
End If
End Function
Sub ImprimerFichier()
Dim NomFichier1 As String
Dim NomFichier2 As String
Dim NomFichier3 As String
Dim x As Long
Dim nbLignes As Integer
Dim I As Integer
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
Dim Nom_Fichier_2 As String
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
x = FindWindow("XLMAIN", Application.Caption)
Range("A2").Select
nbLignes = Range("A2", Selection.End(xlDown)).Cells.Count
For I = 2 To nbLignes
Dim MonFichier As String
MonFichier = "P:\BE\DOSSIER_FAB\" & Cells(I, 1) & ".pdf"
If FichierExiste(MonFichier) = True Then
NomFichier1 = "C:\Users\sleroy\Desktop\Impression OF\" & Cells(I, 2) & ".pdf"
ShellExecute x, "print", NomFichier1, False, False, 1
NomFichier2 = "C:\Users\sleroy\Desktop\Impression OF\Enregistrement Contrôles.pdf"
ShellExecute x, "print", NomFichier2, False, False, 1
NomFichier3 = "P:\BE\DOSSIER_FAB\" & Cells(I, 1) & ".pdf"
ShellExecute x, "print", NomFichier3, False, False, 1
Else
Nom_Fichier = "C:\Users\ccc\Desktop\Impression OF\" & Cells(I, 2) & ".pdf"
With oBjMail
.To = "méthodes@ccc.fr" ' le destinataire
.Subject = "OF Jaune/OF vert" ' l'objet du mail
.Body = "Bonjour," & vbCrLf & vbCrLf & "Les plans de ces OFs ne se trouvent pas dans la base de données accessible par la logistique. Merci de préparer ces OFs (vert ou jaune). OFs en pièces jointes. " & vbCrLf & vbCrLf & "Cdt," 'le corps du mail ..son contenu
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
End With
End If
Next
With oBjMail
.Send
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub
EDIT : Mise en forme du code en utilisant correctement les balises de code (la coloration syntaxique).
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018212 6 nov. 2017 à 11:13
Bonjour
Si ta seule difficulté est (tu le dis toi-même) la recherche dans une plage de cellules, pourquoi nous parler de tout le reste ????
Solution : consulter ton aide interne VBA à la rubrique Range.Find, méthode -->> tu y as ta réponse !
Commence par cela, s'il te plait.
Reviens (si encore en difficulté après cette lecture) en nous montrant le code au moins tenté sur cette base.