Impression d'une feuille excel sous condition PDF

Fermé
pascal - 22 janv. 2013 à 16:05
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 24 janv. 2013 à 09:24
Bonjour, merci d'avance car je sais qu'il y a des personnes sympa qui prennent le temps d'aider les novices comme moi

je vous expose mon probleme j'ai créé une base de données qui est alimentée par un userforme, c'est donnée sont remplient dans un fichier excel puis reprises et positionnées dans une fiche type par le biais le formules dans la feuille 2 de ce même classeur, suis a ca j'imprime la feuille2 jusque la tout est OK.

mon soucis c'est que ce classeur est utilisé par 150 personnes et dont certain pas du tout douer en informatique, et certain n'ont pas connecté d'imprimante a leur ordi, et cela ouvre par défaut le créateur PDF par défaut et plante la saisie et l'impression de ma macro.

mes questions sont:
-comment puis je palier a ça?
-est comment malgré la non impression les données reste sauvegardées dans ma base
j'avais pensé a afficher un message d'erreur si créateur PDF s'ouvre d'afficher un mesbox avec la procédure a suivre mais je ne sais pas créé une condition sur ce cas la.


merci de votre aide

voici mon code
    Dim Wb As Workbook
    Dim WB1 As Workbook
    Dim Ws As Worksheet
    Dim WS1 As Worksheet
    Dim NumLigneVide As Integer
    
        
    If TextSection.Text = "" Then
        MsgBox "renseignez Votre Section EX (T6000)", vbInformation, "champs obligatoire"
        TextSection.SetFocus
        
    ElseIf CboMoteur.Text = "" Then
        MsgBox "renseignez le Moteur a l'aide du menu déroulant", vbInformation, "champs obligatoire"
        CboMoteur.SetFocus
        
    ElseIf CboNom.Text = "" Then
        MsgBox "renseignez le nom du découvreur a l'aide du menu déroulant", vbInformation, "champs obligatoire"
        CboNom.SetFocus
        
    ElseIf CboMoteur.Text = "" Then
        MsgBox "renseignez le Moteur a l'aide du menu déroulant", vbInformation, "champs obligatoire"
        CboMoteur.SetFocus
        
    ElseIf CboAnomalie.Text = "" Then
        MsgBox "renseignez l'anomalie a l'aide du menu déroulant", vbInformation, "champs obligatoire"
        CboAnomalie.SetFocus
        
    ElseIf TextItem.Text = "" Then
        MsgBox "renseignez l'Item (4 chiffres)", vbInformation, "champs obligatoire"
        TextItem.SetFocus
        
    ElseIf TextRef.Text = "" Then
        MsgBox "renseignez la réference (10 chiffres)", vbInformation, "champs obligatoire"
        TextRef.SetFocus
        
    ElseIf TextNumSerie.Text = "" Then
        MsgBox "renseignez le Numero de série ", vbInformation, "champs obligatoire"
        TextNumSerie.SetFocus
        
    ElseIf TextOrdre.Text = "" Then
        MsgBox "renseignez l'Ordre (9 chiffres)", vbInformation, "champs obligatoire"
        TextOrdre.SetFocus
        
    ElseIf TextEcart.Text = "" Then
        MsgBox "renseignez l'écart constater de la Non-Conformitée ", vbInformation, "champs obligatoire"
        TextEcart.SetFocus
        
    ElseIf CboNligne.Text = "" Then
        MsgBox "Renseignez sur quelle ligne la Non-conformité est découverte", vbInformation, "champs obligatoire"
        CboNligne.SetFocus
        
    ElseIf CboMS7.Text = "" Then
        MsgBox "Avez-vous Suspendu votre Operation", vbInformation, "champs obligatoire"
        CboMS7.SetFocus
        
   
    Else
    
        Call classouvert
        
        Set Wb = Workbooks.Open("C:\Users\Propriétaire\Desktop\Turbo+Test\BDTurbo+.xls")
        
        
        
        Worksheets("T+general").Activate
        'on choisi la ligne vide puis le n° de ligne
        Range("B65536").Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        NumLigneVide = ActiveSheet.Columns(2).Find("").Row
        
        'on remplit les données dans le tableau
        ActiveSheet.Cells(NumLigneVide, 2) = TextItem.Text
        ActiveSheet.Cells(NumLigneVide, 3) = CboMoteur.Text
        ActiveSheet.Cells(NumLigneVide, 4) = TextRef.Text
        ActiveSheet.Cells(NumLigneVide, 5) = TextNumSerie.Text
        ActiveSheet.Cells(NumLigneVide, 6) = TextOrdre.Text
        ActiveSheet.Cells(NumLigneVide, 7) = TextSection.Text
        ActiveSheet.Cells(NumLigneVide, 8) = CboAnomalie.Text
        ActiveSheet.Cells(NumLigneVide, 9) = TextEcart.Text
        ActiveSheet.Cells(NumLigneVide, 10) = CboNligne.Text
        ActiveSheet.Cells(NumLigneVide, 11) = CboNom.Text
        ActiveSheet.Cells(NumLigneVide, 12) = Textdate.Text
        ActiveSheet.Cells(NumLigneVide, 19) = CboMS7.Text
        
        ' couleur de la ligne
        Range("a" & (ActiveCell.Row)).Select
        Range("a" & (ActiveCell.Row), "l" & (ActiveCell.Row)).Select
        Selection.Interior.ColorIndex = 48
        
        
        'on efface le formulaire et curseur au debut
        TextItem.Text = ""
        CboMoteur.Text = ""
        TextRef.Text = ""
        TextNumSerie.Text = ""
        TextEcart.Text = ""
        TextOrdre.Text = ""
        TextSection.Text = ""
        CboNligne.Text = ""
        CboNom.Text = ""
        CboAnomalie.Text = ""
        CboMS7.Text = ""
        
        
        'on cache l'userform
        frmnouvelle1.Hide
        
        ' sauvegarde
        WorkbookActivate.Save
            ' ouverture et copie sur le classeur tamp.xls
            Set WB1 = Workbooks.Open("C:\Users\Propriétaire\Desktop\Turbo+Test\BDTurbo+Tamp.xls")
            Set WS1 = WB1.Worksheets(1)
    
        Workbooks("BDTurbo+Tamp.xls").Sheets(1).Range("b4:l10000") = Workbooks("BDTurbo+.xls").Sheets(1).Range("b4:l10000").Value
        Workbooks("BDTurbo+Tamp.xls").Save
        Workbooks("BDTurbo+Tamp.xls").Close True
        


        

       ' impression feuille 2
        ActiveCell.Offset(0, -1).Select
        Selection.Copy
        Sheets("impression").Select
        Range("I3").Select
        ActiveSheet.Paste
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Sheets("T+General").Select
        
        
        'on ferme le classeur
        Workbooks("BDTurbo+.xls").Close True
       
    End If



A voir également:

1 réponse

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
23 janv. 2013 à 13:52
Bonjour,


Par ou commencer?

Par ta question : Comment tester le nom de l'imprimante active, et si elle contient "pdf", ne pas imprimer. C'est cela?
Si oui, ce code devrait suffire :

Dim Imprimante As String

Imprimante = Application.ActivePrinter
If InStr(UCase(Imprimante), "PDF") <> 0 Then
    MsgBox "Impossible d'imprimer sur ce poste", vbCritical
Else
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If 


Ensuite, ton code... n'est pas orthodoxe.

1- tu as deux fois, dans les tests initiaux :
 ElseIf CboMoteur.Text = "" Then
        MsgBox "renseignez le Moteur a l'aide du menu déroulant", vbInformation, "champs obligatoire"
        CboMoteur.SetFocus


2-
Worksheets("T+general").Activate
        'on choisi la ligne vide puis le n° de ligne
        Range("B65536").Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        NumLigneVide = ActiveSheet.Columns(2).Find("").Row

Inutile de sélectionner!!!
Donc, à remplacer par :
NumLigneVide = Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row + 1


3-
Range("a" & (ActiveCell.Row)).Select
        Range("a" & (ActiveCell.Row), "l" & (ActiveCell.Row)).Select
        Selection.Interior.ColorIndex = 48

à remplacer par :
Range("A" & NumLigneVide & ":I" & NumLigneVide).Interior.ColorIndex = 48


4- syntaxe étrangère pour moi :
WorkbookActivate.Save

Je ne connais que : ActiveWorkBook

5-
Set WS1 = WB1.Worksheets(1)
te sers à quoi puisqu'après tu utilises Sheets(1) au lieu de WS1...

etc.
0
bonjour je viens de tester ton code cela marche impeccable, et merci pour t correction il faut savoir que cela fait 2 mois que j ai commence sur excel ( je ne savais même pas faire une formule somme)
merci encore
j aurai une question supplémentaire
s aurai tu faire une condition si lors de l ouverture de mon fichier qui mette un timer si le fichier s'ouvre en lecture seule ?
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
24 janv. 2013 à 09:24
Bonjour,

Teste quelque chose comme ceci :

Dim t

If ActiveWorkbook.ReadOnly Then
    t = timer
End If
'bla bla ton code ICI
If ActiveWorkbook.ReadOnly Then
   MsgBox timer - t
End If
0