Impresssion ne s'arrête plus

Question

Bonjour,

J'ai écrit un programme en VBA pour Excel qui traite des données puis transmet le résultat à Word qui l'imprime. J'ai utilisé ce procédé pour plusieurs petites applications qui ont toutes fonctionné correctement mais celle-ci, qui devrait imprimer un document constitué de 228 "chapitres" numérotés automatiquement continuer d'imprimer alors qu'il en est au chapitre 1270 et quelques. Le classeur Excel qui contient cette appli est fermé. J'ai désactivé puis réactivé le spouleur d'impression, j'ai éteint puis rallumé l'imprimante mais elle continue de cracher du papier. Qui voit une solution ?

Merci d'avance

Cordialement

Pierre

Answer 1

Rebonjour Daniel,

Ne te casse plus la tête sur mon code, mon imprimante est redevenue normale ! J'ai essayé de la réinstaller, j'ai fait toute sorte de manoeuvres (le setup ne trouvait aucune imprimante sur mon système !) et après ça j'ai tout rebranché et j'ai pu imprimer le document qui attendait depuis vendredi ! Pour te donner une idée je devais obtenir 228 actes numérotés automatiquement et les derniers numéros imprimés sont supérieurs à 1600 !

Merci de ton aide et de ta patience.

Cordialement

Pierre

Answer 2

Bonjour Daniel et Bonne année !

Désolé de cette réaction tardive: je n'étais pas chez moi ces derniers jours et du PC de mon amie je n'avais pas accès à la Communauté. J'ai tout de suite vidé la liste d'attente d'impression mais le phénomène a continué.

Je ne suis pas sûr que le problème vienne de mon code mais le voici tout de même.

Je dois préciser deux choses: primo, il agit sur une feuille Excel utilisée comme base de données généalogiques, chaque colonne représentant un champ: Nom, prénom, date de naissance, lieu et commune de domicile; etc. etc.; et secundo comme dans bien des cas certains données ne sont pas enregistrées ou font défaut suite à une erreur, un oubli, il y a énormément d'opérations conditionnelles, ce qui allonge le code démesurément. MOn code:

Option Explicit

Public GED As String, ABBR As String, REPO As String, CALN As String
Public MEDI As String, TEXT As String, CONT As String
Public ligne As Integer, colonne As Integer, compteur As Integer
Public L As Integer, C As Integer, Today As Object, index As Integer
Public r As Range, mes_gedcoms As String, lieu As String
Public domicile As String, deces As String, parenté As String, codefeuille As String
Public Aujourdhui As Variant, son_age As Variant, annee As Variant
Public Jour As Variant, Heure As Variant, sa_dateN As Variant

Sub creation_K_gedcoms_d_apres_XL()
'version BMS Le Chambon sur Lignon: naissances)

ThisWorkbook.Sheets("Chambon_A_Bap_Donnees").Activate
'la feuille compte 228 lignes

Set r = ThisWorkbook.Sheets("Chambon_A_Bap_Donnees").Range("A1").CurrentRegion

GED = ""
compteur = 1
ligne = 3
L = 1
C = 1
codefeuille = Cells(3, 1).Value

For ligne = 3 To r.Rows.Count

'entete à copier
GED = GED & "0 @" & Format(compteur, "0000") & "S" & "@" & " " & "SOUR" & Chr(10)
GED = GED & "1 QUAY" & " " & Cells(ligne, 103).Value & Chr(10)
GED = GED & "1 TITL" & " " & Cells(ligne, 5).Value & " " & ActiveSheet.Cells(ligne, 10).Value & " " & Cells(ligne, 11).Value _
& " " & Cells(ligne, 12).Value & " " & Cells(ligne, 17).Value & Chr(10)
GED = GED & "1 REPO" & " " & "@" & Cells(ligne, 4).Value & "@" & Chr(10)
GED = GED & "2 CALN" & " " & Cells(ligne, 6).Value & Chr(10)
GED = GED & "3 MEDI" & " " & Cells(ligne, 68).Value & Chr(10)
GED = GED & "2 CONT" & " " & "Réf. Excel:" & " " & Cells(ligne, 1).Value & _
" " & Cells(ligne, 2).Value & Chr(10)
Aujourdhui = Date
'fin de l'entete à copier

ThisWorkbook.Sheets("test_time").Activate
Heure = Format(Time, "hh:mm:ss")
Cells(1, 1).Value = Heure
Jour = Format(Date, "dd, mm, yyyy")
ActiveCell.Offset(0, 1).Value = Date

ThisWorkbook.Sheets("Chambon_A_Bap_Donnees").Activate

ThisWorkbook.Sheets("Chambon_A_Bap_Donnees").Activate
GED = GED & "2 CONT" & " " & "Gedcom construit d'après base Excel" & ", " & "feuille" _
& " " & ThisWorkbook.ActiveSheet.Name & " " & "le" & " " & Aujourdhui & " " & "à " & Heure & Chr(10)
GED = GED & "2 CONT" & " " & "(Code VBA © Pierre Ruel 2015)"

GED = GED & Chr(10) & "2 CONT" & " " & "Texte résumé: " & Chr(10)

GED = GED & "2 CONT" & " " & "L'enfant" & " " & Cells(ligne, 10) & " " & Cells(ligne, 11)
GED = GED & " " & "est né/e le " & Cells(ligne, 12).Value
If Cells(ligne, 17).Value <> "" Then
GED = GED & " " & "au lieu nommé" & " " & Cells(ligne, 17).Value
End If
GED = GED & ", (commune:" & " " & Cells(ligne, 18).Value & ")." & Chr(10)
'baptême
If Cells(ligne, 20).Value <> "" Then
GED = GED & "Il a été baptisé le" & " " & Cells(ligne, 20).Value
End If
If Cells(ligne, 21).Value <> "" Then
GED = GED & " " & "au lieu nommé " & Cells(ligne, 21).Value & Chr(10)
End If
If Cells(ligne, 22).Value <> "" Then
GED = GED & " " & "par le pasteur" & " " & Cells(ligne, 22).Value & Chr(10)
End If
'père
GED = GED & "2 CONT" & " " & "Les parents sont" & " " & Cells(ligne, 23). _
Value & " " & Cells(ligne, 24).Value & ","
'age pere
Select Case Cells(ligne, 25).Value
Case Is = ""
GED = GED & " " & "âge: [omis], "
Case Is = "néant"
GED = GED & " " & "âge: [omis], "
Case Is = "--"
GED = GED & " " & "âge: [omis], "
Case Is = Chr(134)
GED = GED & " " & Chr(134)
Case Else
GED = GED & " âgé de" & " " & Cells(ligne, 25).Value _
& " " & "ans, "
End Select

'profession pere
If Cells(ligne, 27).Value <> "" Then
GED = GED & Cells(ligne, 27).Value & " " & "de son métier," & Chr(10) 'VARIANTE
End If

'domicilepere:
If Cells(ligne, 28).Value <> "" Then
GED = GED & "3 CONC" & " " & "demeurant au lieu nommé" & " " & Cells(ligne, 28).Value & ")"
End If

communepere:
If Cells(ligne, 29).Value <> "" Then
GED = GED & " (commune:" & " " & Cells(ligne, 29).Value & ")" & Chr(10)
End If

mere:
GED = GED & "2 CONT" & " " & "et" & " " & Cells(ligne, 31).Value & " " & Cells(ligne, 32).Value
'age mere
Select Case Cells(ligne, 33).Value
Case Is = ""
GED = GED & "" & ", âge: [omis],"
Case Is = "néant"
GED = GED & "" & ", âge: [omis],"
Case Is = "--"
GED = GED & "" & ", âge: [omis],"
Case Is = Chr(134)
GED = GED & " " & Chr(134)
Case Else
GED = GED & ", âgée de" & " " & Cells(ligne, 33).Value _
& " " & "ans, "
End Select

'date naissance mere
If Cells(ligne, 34).Value <> "" Then
GED = GED & " " & "date de naissance" & " " & Cells(ligne, 34).Value & Chr(10)
End If

If Cells(ligne, 35).Value <> "" Then
GED = GED & "2 CONT" & " " & Cells(ligne, 35).Value & " " & "de son métier,"
End If

If Cells(ligne, 36).Value <> "" Then
GED = GED & " domiciliée au lieu nommé" & " " & Cells(ligne, 36).Value
End If
If Cells(ligne, 29).Value <> "" Then
GED = GED & ", (commune:" & " " & Cells(ligne, 29).Value & ")." & Chr(10)
End If

'parrain_marraine
If Cells(ligne, 39).Value <> "" Then
GED = GED & "2 CONT" & " " & "Son parrain est" & " " & Cells(ligne, 39).Value & " " & _
Cells(ligne, 40).Value & ","
End If
If Cells(ligne, 41).Value <> "" Then
GED = GED & "âgé de " & Cells(ligne, 41).Value & " " & "ans."
End If
If Cells(ligne, 42).Value <> "" Then
GED = GED & " " & Cells(ligne, 42).Value & " " & "de son état" & Chr(10)
End If
If Cells(ligne, 43).Value <> "" Then
GED = GED & " " & "domicilié au lieu nommé " & Cells(ligne, 43).Value
End If
If Cells(ligne, 44).Value <> "" Then
GED = GED & ", " & "(commune:" & " " & Cells(ligne, 44).Value & "), "
End If
If Cells(ligne, 46) <> "" Then
GED = GED & "sa marraine " & Cells(ligne, 46).Value & " " & Cells(ligne, 47).Value
End If
If Cells(ligne, 50).Value <> "" Then
GED = GED & " demeurant au lieu nommé " & Cells(ligne, 50).Value
End If
If Cells(ligne, 51).Value <> "" Then
GED = GED & " " & "(commune:" & " " & Cells(ligne, 51).Value & ")." & Chr(10)
End If

'Témoins:
'No 1 53, 54
If Cells(ligne, 53).Value = "" Then
GoTo temoin2
End If
GED = GED & "2 CONT Etaient témoins: " & Chr(10)
GED = GED & "N° 1: " & Cells(ligne, 53).Value & " " & Cells(ligne, 54).Value
If Cells(ligne, 55).Value = "majeur" Then
GED = GED & " " & "majeur,"
End If
'âge 68
If Cells(ligne, 55).Value <> "" Then
If Cells(ligne, 55).Value <> "majeur" Then
If Cells(ligne, 55).Value <> "omis" Then
GED = GED & ", âgé de" & " " & Cells(ligne, 55) & " " & "ans,"
End If
End If
End If

If Cells(ligne, 56).Value <> "" Then
GED = GED & " " & Cells(ligne, 56).Value & " " & "de son état,"
End If

'domicile temoin1 57, 58

domicile = Cells(ligne, 57).Value
Select Case domicile
Case Is = "omis"
If Cells(ligne, 58).Value <> "" Then
GED = GED & " commune de domicile:" & " " & Cells(ligne, 58).Value & ", " & Chr(10)
End If
Case Is = ""
If Cells(ligne, 58).Value <> "" Then
GED = GED & " commune de domicile:" & " " & Cells(ligne, 58).Value & ", " & Chr(10)
End If
Case Is <> ""
If Cells(ligne, 58).Value <> "" Then
If Cells(ligne, 58) <> "omis" Then
GED = GED & " demeurant au lieu nommé" & " " _
& Cells(ligne, 57).Value & " (commune:" _
& " " & Cells(ligne, 58).Value & ") " & Chr(10)
End If
End If
End Select

parenté = Cells(ligne, 59).Value
Select Case parenté
Case Is = ""
GoTo temoin2
Case Is = "sans"
GoTo temoin2
Case Is = "aucun"
GoTo temoin2
Case Else
GED = GED & "degré de parenté:" & " " & Cells(ligne, 59).Value & "." & Chr(10)
End Select

GED = GED & "2 CONT"

temoin2:
'temoin2: 60, 61
If Cells(ligne, 60).Value = "" Then
GoTo note_etc
End If

GED = GED & "N° 2: " & Cells(ligne, 60).Value & " " & Cells(ligne, 61).Value
If Cells(ligne, 62).Value = "majeur" Then
GED = GED & " " & "majeur,"
End If
'âge 62
If Cells(ligne, 62).Value <> "" Then
If Cells(ligne, 62).Value <> "majeur" Then
If Cells(ligne, 62).Value <> "omis" Then
GED = GED & ", âgé de" & " " & Cells(ligne, 62) & " " & "ans,"
End If
End If
End If

If Cells(ligne, 76).Value <> "" Then
GED = GED & " " & Cells(ligne, 63).Value & " " & "de son état, "
End If

'domicile 64, 65
domicile = Cells(ligne, 64).Value
Select Case domicile
Case Is = "omis"
If Cells(ligne, 65).Value <> "" Then
GED = GED & " commune de domicile:" & " " & Cells(ligne, 65).Value & ". " & Chr(10)
End If
Case Is = ""
If Cells(ligne, 65).Value <> "" Then
GED = GED & " commune de domicile:" & " " & Cells(ligne, 65).Value & ", " & Chr(10)
End If
Case Is <> ""
If Cells(ligne, 65).Value <> "" Then
If Cells(ligne, 65) <> "omis" Then
GED = GED & " demeurant au lieu nommé" & " " _
& Cells(ligne, 64).Value & " (commune:" _
& " " & Cells(ligne, 65).Value & "). " & Chr(10)
End If
End If
End Select

parenté = Cells(ligne, 66).Value
Select Case parenté
Case Is = ""
GoTo fin_temoins
Case Is = "sans"
GoTo fin_temoins
Case Is = "aucun"
GoTo fin_temoins
Case Else
GED = GED & "degré de parenté:" & " " & Cells(ligne, 66).Value & "." & Chr(10)
End Select

fin_temoins:

note_etc:

GED = GED & Chr(10) & "2 CONT" & " " & "Note:" & " " & Cells(ligne, 67).Value & Chr(10)

GED = GED & "2 CONT" & " SOURCE: Type d'original:" & " " & Cells(ligne, 68).Value _
& ". " & "Mon support: " & Cells(ligne, 69).Value & ". "
GED = GED & "Mon archivage: " & _
Cells(ligne, 70).Value & Chr(10)

GED = GED & "2 CONT" & " " & "Relevé du" & " " & Cells(ligne, 71).Value _
& ". " & "Saisie du" & " " & Cells(ligne, 72).Value & ". "

GED = GED & "Feuille XL" & " " & Cells(ligne, 1).Value & "." _
& " " & "Naissance No" & " " & Cells(ligne, 2).Value & ". " & "Commune/Paroisse:" _
& " " & Cells(ligne, 3).Value & Chr(10)

GED = GED & "2 CONT" & ". " & "Dépôt d'archives:" & " " & "@" & Cells(ligne, 4).Value _
& "@" & ". " & "Cote registre:" & " " & Cells(ligne, 6).Value & ". "

If Cells(ligne, 7).Value <> "" Then
GED = GED & "" & "No d'acte:" & " " & Cells(ligne, 7).Value & ". "
End If
'End If

date_acte:
If Cells(ligne, 9).Value <> "" Then
GED = GED & "" & "Acte du " & Cells(ligne, 9).Value & Chr(10)
End If
'End If

GED = GED & Chr(10) & "2 CONT Nombre d'enregistrements dans cette base" & " " & _
ThisWorkbook.ActiveSheet.Name & ": " & (r.Rows.Count - 2) & Chr(10)

GED = GED & Chr(10) & "2 CONT Source aussi valable pour " & Chr(10)
GED = GED & "2 CONT" & " " & "Père: " & Cells(ligne, 23).Value & " " & Cells(ligne, 24).Value _
& " en vie le " & Cells(ligne, 12).Value & ", " & Chr(10)
GED = GED & "2 CONC" & " " & "conjoint de: " & Cells(ligne, 31).Value & " " & _
Cells(ligne, 32).Value & " mariage avant le " & Cells(ligne, 12).Value & ", " & Chr(10)
GED = GED & "2 CONT" & " " & "Mère: " & Cells(ligne, 31).Value & " " & Cells(ligne, 32).Value _
& " en vie le " & Cells(ligne, 12).Value & ", " & Chr(10)
GED = GED & "2 CONC" & " " & "conjointe de: " & Cells(ligne, 23).Value & " " & _
Cells(ligne, 24).Value & " mariage avant le " & Cells(ligne, 12).Value & Chr(10)

GED = GED & "2 CONT" & " " & Cells(ligne, 39).Value & " " & Cells(ligne, 40).Value & ","
If Cells(ligne, 44).Value <> "" Then
GED = GED & " " & "habitant la commune de" & " " & Cells(ligne, 44).Value & ", "
End If
If Cells(ligne, 41) <> "" Then
If Cells(ligne, 41) <> "majeur" Then
GED = GED & "âgé de" & " " & Cells(ligne, 55) & " " & "ans en" & " " & Cells(ligne, 15) & Chr(10)
Else
If Cells(ligne, 41).Value = "majeur" Then
GED = GED & " " & "majeur" & "." & Chr(10)
End If
End If
End If

GED = GED & Chr(10) & "2 CONT" & " " & Cells(ligne, 46).Value & " " & Cells(ligne, 47).Value & ","
If Cells(ligne, 51).Value <> "" Then
GED = GED & " " & "habitant la commune de" & " " & Cells(ligne, 51).Value & ", "
End If
If Cells(ligne, 48) <> "" Then
If Cells(ligne, 48) <> "majeur" Then
GED = GED & "âgé de" & " " & Cells(ligne, 48) & " " & "ans en" & " " & Cells(ligne, 15) & Chr(10)
Else
If Cells(ligne, 48).Value = "majeur" Then
GED = GED & " " & "majeur" & "." & Chr(19)
End If
End If
End If

GED = GED & Chr(10) & "2 CONT" & " " & "A l'origine, toutes ces données généalogiques ont été saisies" & " "
GED = GED & "sous forme de bases de données sous Excel, format incompatible avec la plupart des logiciels" & " "
GED = GED & "de généalogie (notamment Heredis). Elles ont été transformées en résumés standardisés au moyen" & " "
GED = GED & "d" & "'" & "un programme en VBA pour Excel rédigé par l'auteur de la présente généalogie." & Chr(10) & Chr(10)

compteur = compteur + 1

Next
GED = GED & "0 RTLR"

'======================bloc date et heure ===================================
ThisWorkbook.Sheets("test_time").Activate
Range("A1").Select
Selection.Replace What:=":", Replacement:="_", LookAt:=xlPart
Selection.Replace What:="/", Replacement:="_", LookAt:=xlPart
Heure = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
'Elimine les caractères interdits
Selection.Replace What:=".", Replacement:="_", LookAt:=xlPart
Selection.Replace What:=",", Replacement:="_", LookAt:=xlPart
Selection.Replace What:="/", Replacement:="_", LookAt:=xlPart
Jour = Selection.Value

    ThisWorkbook.Sheets("Chambon\_A\_Bap\_Donnees").Activate  

'=====================fin du bloc date et heure=============================

Call imprime_GED

End Sub

Sub imprime_GED()
index = index + 1

' Crée un gedcom dans Word en utilisant Automation (liaison tardive)
Dim WordApp As Object
Dim saveasname As String
Dim myRange As Range

' cree le nom du fichier
saveasname = "allged" & codefeuille & "_" & Jour & "_" & Heure & ".doc"

' Lance Word et crée un objet
Set WordApp = CreateObject("Word.Application")

' Transmet les commandes à Word
With WordApp
.Documents.Add
With .Selection
.Font.Name = "courier new"
.Font.Size = 12
.ParagraphFormat.Alignment = 0
.Font.Bold = False
.Range = GED
End With
End With

    With WordApp  
    '   pour imprimer effectivement  
        '.ActiveDocument.PrintOut ', Range:=3, From:="1", To:="3"  

'Il est inutgile d'imprimer systématiquement ces documents car la version numérique est importée telle quelle
'dans mon logiciel de généalogie; mais l'impression (partielle ou complète) est utile pour la relecture

' Pour sauvegarder
.ActiveDocument.SaveAs "E:" & "3_G_E_N_E_A_L_O_G_I_E\3_Reprise_création_sources_GED\GED_N" & saveasname
End With
' Tuer l'objet
WordApp.Quit
Set WordApp = Nothing
End Sub

Answer 3

Dans les paramètres de Windows, affiche les imprimantes, choisis la tienne et affiche. Sélectionne ton imprimante et affiche la file d'impression. Tu peux alors supprimer les impressions en attente.

Pour joindre le code, fais simplement un copier coller.

Daniel

Answer 4

Bonjour Daniel et merci,

J'ai éteint l'ordi mais l'impression a repris quand je l'ai rebooté.

Avant de poster des km de code je dois préciser que mon module Word est destiné à imprimer et à sauvegarder le document obtenu; or le document sauvegardé est limité aux 228 "chapitres". Je ne vois d'ailleurs pas comment joindre du code. Merci de ton intérêt.

Cordialement

Pierre

Answer 5

Bonjour,

Le fait de redémarrer Windows devrait régler le problème. Maintenant, pourquoi la macro dysfonctionne, il faudrait que tu en postes le code.

Cordialement.

Daniel