Textes longs et mise en page

svdvet

XLDnaute Nouveau
Bonjour,
quelqu'un s'est t'il déjà penché sur la façon d'alimenter une page excel en texte de longuer variable, mais parfois assez long, en vue de son impression. J'ai pensé à une usine à gaz qui , à partir de la longueur de la chaine de caractère contenue dans les controles de l'Usf permettrait de connaitre, en fonction de la police et de la taille des caractères, le nombre de cellules à utiliser et à fusionner pour avoir le texte final sur le nombre de lignes voulu et indiquer également le décalage nécessaire pour la suite du texte (pour ce faire, un modèle de page avec des items à compléter est plus compliqué à mettre en œuvre et le texte prédéfini, non issu de l'Usf devra etre également codé dans le VBA (reste à savoir comment et où le disposer en fonction des cellules déjà remplies par le texte de longueur variable le précédant). C'est une bonne piste ou d'autres solutions vous paraissent plus élégante (ou plus efficace)?
 

dg62

XLDnaute Barbatruc
Bonjour Svdvet,

C'était une boutade !:)
mais en l'occurrence il est difficile de répondre sans savoir exactement ce que tu souhaites (un exemple serait nécessaire).

Sinon pour en revenir à word il est facile de l'intégrer à Excel (Insertion Objet Word)

@+
 

eriiic

XLDnaute Barbatruc
Bonjour,

ça parait bien compliqué ton truc.
Plus simplement tu ne peux pas régler tes largeurs de cellules pour qu'elles rentrent sur une page, et tu mets ton blabla dans une cellule avec 'Renvoyer à la ligne automatiquement'.
Rien à calculer, et s'il faut 2 feuilles et bien... il faut 2 feuilles
eric
 

svdvet

XLDnaute Nouveau
c'est exactement ça le point de départ le plus simple et le plus logique mais j'ai du rater quelque chose (cf PJ). formulaire + CR en copie d'écran et pdf final envoyé par mail,… reste aussi le problème du décalage du "tableau" antibiogramme qui doit se trouver sur une page sans être coupé,…
début du code:
Sub Data_Transfer()
Dim j As Integer
Dim temp_atbq As String
Dim temp_atbq_sensible As String
Sheets("CR").Activate
Application.EnableEvents = False


Select Case (Userform1.Lbinfo.Caption)
Case "Vous consultez un enregistrement existant" 'fontionnera aussi si on a modifié l'analyse consultée (donc à modifier pour qu'il ne se réroule pas sans enregistrement lorsd emconsultation de fiche précednente avec modification de celle-ci non encore enregistrée)
Worksheets("CR").Range("E11") = Userform1.lbl_ref_analyse.Caption
Worksheets("CR").Range("B11") = Userform1.TxtB_Date_prlvt
Worksheets("CR").Range("B12") = Userform1.TxtB_Date_lecture.Text
Worksheets("CR").Range("B14") = Userform1.CB_ChoixNom.Text
Worksheets("CR").Range("B15") = Userform1.CB_ville.Text
Worksheets("CR").Range("B16") = Userform1.TxtB_Num_cheptel.Text
Worksheets("CR").Range("B19") = Userform1.TxtB_ID_animal.Text
Worksheets("CR").Range("B21") = Userform1.Rang_lactation.Text
Worksheets("CR").Range("B22") = Userform1.CB_Quartier
Worksheets("CR").Range("B23") = Userform1.TxtB_Date_velage.Text

If Userform1.CkB_Mammite_clinique.Value = True Then
Worksheets("CR").Range("F21") = "Oui"
If Userform1.CkB_rechute.Value = True Then
Worksheets("CR").Range("F22") = "Oui"
If Userform1.CkB_rechute.Value = True Then
Worksheets("CR").Range("F23") = "Oui"
Else: Worksheets("CR").Range("F23") = "Non"
End If
If Userform1.CkB_recidive.Value = False Then
Worksheets("CR").Range("F23") = "Oui"
Else: Worksheets("CR").Range("F24") = "Non"
End If
Else: Worksheets("CR").Range("F22") = ""
Worksheets("CR").Range("F23") = ""
End If
End If

Worksheets("CR").Range("B26") = Userform1.TxtB_CCI1.Text
Worksheets("CR").Range("C26") = Userform1.TxtB_CCI2.Text
Worksheets("CR").Range("D26") = Userform1.TxtB_CCI3.Text
Worksheets("CR").Range("B27") = Userform1.TxtB_CCT1.Text
Worksheets("CR").Range("C27") = Userform1.TxtB_CCT2.Text
Worksheets("CR").Range("D27") = Userform1.TxtB_CCT3.Text
Worksheets("CR").Range("B29") = Userform1.TxtB_Date_dernier_traitement.Text
Worksheets("CR").Range("B30") = Userform1.CB_TRAITEMENT_IM
Worksheets("CR").Range("C30") = Userform1.CB_TRAITEMENT_INJ
Worksheets("CR").Range("D30") = Userform1.CB_TRAITEMENT_AUTRE
Worksheets("CR").Range("B34") = Userform1.TxtB_interpretation_ctrl_neg
Worksheets("CR").Range("B35") = Userform1.TxtB_interpretation_ctrl_pos
'--------procédure pour afficage résultats antibiogramme (fonctionne pour donner sur une ligne la liste des antibiotiques sensibles ou resistants mais j'ai choisi de présenter le rapport finalement ous forme de tableau avec de croix dans deux colonnes (sensible résistant) car la mise en page le permet (ce qui est au dessus du tableau n'influence pas la mise en page et donc le tableau ne se trouve pas coupé en 2, sinon l aurait fallu mettre une donctiotion sur le début du tableau de façon à ce que si la dernière ligne du tableau se trouve en page 2, alors, tous le tableau est en page 2)
'If Userform1.Antibiogramme.Visible = True Then
'For j = 0 To Userform1.Antibiogramme.ListCount - 1
' If Userform1.Antibiogramme.Selected(j) = True Then
' temp_atbq = temp_atbq & Userform1.Antibiogramme.List(j) & " ; "
'Else: temp_atbq_sensible = temp_atbq_sensible & Userform1.Antibiogramme.List(j) & " ; "
' End If
'Next j
' Worksheets("CR").Range("C42") = temp_atbq
'Worksheets("CR").Range("C44") = temp_atbq_sensible
'Else
'Worksheets("CR").Range("C42") = "L'antibiogramme n'est pas interprétable"
'End If
Application.EnableEvents = True
End Select
 

Pièces jointes

  • Capture d’écran 2017-08-27 à 22.54.10.pdf
    2 MB · Affichages: 21
  • Res bacterio lait45216356.pdf
    63.5 KB · Affichages: 21

eriiic

XLDnaute Barbatruc
reste aussi le problème du décalage du "tableau" antibiogramme qui doit se trouver sur une page sans être coupé,…
Il faut voir si ses 1ère et dernière ligne sont sur la même page. Et si non insérer un saut de page manuel au-dessus de la 1ère.

Une fonction pour avoir le n° de page d'une cellule :
VB:
Sub numeroPage_Cellule_X()

Application.ScreenUpdating = False
ActiveWindow.View = xlPageBreakPreview

MsgBox numeroPage(Range("A51"))

ActiveWindow.View = xlPageLayoutView
Application.ScreenUpdating = True

End Sub

Function numeroPage(Cellule As Range) As Integer

  Dim VPC As Integer, HPC As Integer
  Dim VPB As VPageBreak, HPB As HPageBreak
  Dim Wksht As Worksheet
  Dim Col As Integer, Ligne As Long

  Set Wksht = Cellule.Worksheet
  Ligne = Cellule.Row
  Col = Cellule.Column
  If Wksht.PageSetup.Order = xlDownThenOver Then
    HPC = Wksht.HPageBreaks.Count + 1
    VPC = 1
  Else
    VPC = Wksht.VPageBreaks.Count + 1
    HPC = 1
  End If
  numeroPage = 1
  For Each VPB In Wksht.VPageBreaks
    If VPB.Location.Column > Col Then Exit For
    numeroPage = numeroPage + HPC
  Next VPB
  For Each HPB In Wksht.HPageBreaks
    If HPB.Location.Row > Ligne Then Exit For
    numeroPage = numeroPage + VPC
  Next HPB
End Function
Je n'ai plus l'auteur, désolé pour lui.

Insérer un saut vertical au-dessus de la ligne 25 :
VB:
Worksheets("Feuil1").Rows(25).PageBreak = xlPageBreakManual
eric
 

Discussions similaires

Réponses
28
Affichages
1 K

Statistiques des forums

Discussions
312 190
Messages
2 086 044
Membres
103 105
dernier inscrit
fofana