XL 2010 Chèque

zozo · 6 Octobre 2019

Le bonjour à tous les membres du forum,
J'ai réalisé un utilitaire pour imprimer sur des chèques.

Le problème que je rencontre au niveau du montant en lettres, est comment imprimer la 2ème ligne sans couper le dernier mot de la 1ère ligne.
La 1ère a un maximum de 62 caractères, et tout le reste sur la 2ème ligne.

L'utilisateur ne voit pas la feuille "impression" ("feuille masquée").

Mon but et que ça se fasse automatique sans que l'utilisateur n'intervienne.
Je n'arrive pas comment détecter le dernier mot si la 1ère chaîne dépasse 62 Caractères, et si c'est le cas, comment commencer à imprimer la 2ème chaîne à partir du dernier mot de la 1ère chaîne.
Merci pour toute intervention de votre part.

patricktoulon · 7 Octobre 2019

re

bon ok comme tu veux

alors tu va mettre ceci dans ton module1

VB:

Function two_line_of_string(v As Range, X As Long)
    Dim limite&, A&
    limite = v.MergeArea.Width / v.MergeArea.ColumnWidth    'nombre de caractères possibles dans une cellule  avec des colonnes fusionnées
    A = InStrRev(Mid(v.Value, 1, limite), " ")' le premier espace avant cette limite 
    Select Case X
    Case 1: two_line_of_string = Left(v.Value, A) 'x=1 la première partie
    Case 2: two_line_of_string = Mid(v.Value, A + 1, Len(v.Value))'x=2 la 2d partie
    End Select
End Function

et dans tes cellules les formules
H14 tu met = two_line_of_string(cheque!C16;1)
G15 tu met = two_line_of_string(cheque!C16;2)

resultat

eriiic · 7 Octobre 2019

j'ai essayé toutes les tentatives sans le résultat voulu.

Tu plaisantes ?
J'ai testé avant de mettre mon post #10...
Et d'autres propositions fonctionnent également.
eric

zozo · 7 Octobre 2019

patricktoulon à dit:
re

bon ok comme tu veux

alors tu va mettre ceci dans ton module1

VB:

Function two_line_of_string(v As Range, X As Long) Dim limite&, A& limite = v.MergeArea.Width / v.MergeArea.ColumnWidth 'nombre de caractères possibles dans une cellule avec des colonnes fusionnées A = InStrRev(Mid(v.Value, 1, limite), " ")' le premier espace avant cette limite Select Case X Case 1: two_line_of_string = Left(v.Value, A) 'x=1 la première partie Case 2: two_line_of_string = Mid(v.Value, A + 1, Len(v.Value))'x=2 la 2d partie End Select End Function

et dans tes cellules les formules
H14 tu met = two_line_of_string(cheque!C16;1)
G15 tu met = two_line_of_string(cheque!C16;2)

resultat
Regarde la pièce jointe 1042756

Bonjour,
je n'ai pas su à quel niveau l'insérer.
STP, peux-tu me le faire, je t'envoi mon fichier.
Merci pour ton intervention.

zozo · 7 Octobre 2019

eriiiic à dit:
Tu plaisantes ?
J'ai testé avant de mettre mon post #10...
Et d'autres propositions fonctionnent également.
eric

Bonjour,
Peux-tu m'envoyer ton test, peut-être que je l'ai mal exploité.
Merci

patricktoulon · 7 Octobre 2019

Jacky67 · 7 Octobre 2019

Bonjour à tous
Peux-tu me dire ce qui ne fonctionne pas dans ce classeur

patricktoulon · 7 Octobre 2019

bonjour Jacky67

VB:

Sub ImprimeCHQ()
    Dim x, c, y,chaine
    Application.ScreenUpdating = False
    With Worksheets("Impression")
        chaine = Feuil1.[c16]
        'x = Split(Feuil1.[c16], " ")
        'For Each c In x
        ' If Len(y & " " & c) < 62 Then
        'y = y & " " & c
        'End If
        'Next
        '.[h14] = Right(y, Len(y) - 1)
        '.[g15] = Mid(Feuil1.[c16], Len(y), Len(Feuil1.[c16]))

        .[h14] = chaine
        If Len(chaine) > 62 Then
            x = InStrRev(Mid(chaine, 1, 62), " ")
            .[h14] = Left(chaine, x)
            .[g15] = Mid(chaine, x + 1, Len(chaine))
        End If

        '
        .Visible = True
        '.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        '.Visible = False
    End With
    Application.ScreenUpdating = True
End Sub

Jacky67 · 7 Octobre 2019

Bonjour patricktoulon
Oui, oui
Ce que je voulais savoir c'est qu'avec toutes les propositions qui ont été faites et qui pour la plupart (pour ne pas dire toutes) fonctionnent, zozo ne trouve pas son bonheur.

patricktoulon · 7 Octobre 2019

re
et puis pour être honnête la chaine en exemple étant un des exemples le plus long pour ne pas couper les tranches de 3 je couperais après mille
mille etant le primer séparateur changement de tranche
la lecture est plus aisée
je dis moi .......

patricktoulon · 7 Octobre 2019

re
@Jacky67
c'est vrai que la il a le choix en formule /en vba appliqué par formule / en vba application par sub
bon ca va a moi il me doit pas de chèque

zozo · 7 Octobre 2019

patricktoulon à dit:
re

Génial, Merci beaucoup pour ton aide.

zozo · 7 Octobre 2019

Jacky67 à dit:
Bonjour à tous
Peux-tu me dire ce qui ne fonctionne pas dans ce classeur

Toujours problème de coupure.
patricktoulon a trouvé la solution au problème.
Merci à toi et à tout le forum pour les efforts.

Modeste geedee · 7 Octobre 2019

Bonsour®

eriiiic à dit:
Mais la proposition de modeste est maligne ;-)

contraire de bénigne ??? ... en quoi ma proposition peut-elle faire du mal ???
encore faut-il l'employer correctement !

c'est qui le zozo ???

elle ne réclame aucun code ou calcul de césure, Excel s'occupe de tout...
je n'ai même pas touché à la présentation initiale, hormis la zone F14:K15,
hauteur de ligne et largeur de colonne inchangées
la copie d'écran est explicite !!!

eriiic · 7 Octobre 2019

Peux-tu m'envoyer ton test, peut-être que je l'ai mal exploité.

Il suffit de coller ça en remplacement de tes lignes :

VB:

    With Worksheets("Impression")
        x = Feuil1.[c16].Value
        If Len(x) <= 62 Then x = x & "|" Else Mid(x, InStrRev(x, " ", 62), 1) = "|"
        .[h14:H15] = Application.Transpose(Split(x, "|"))
        .Activate
    End With

@Modeste : maligne dans le sens de astucieuse bien entendu ;-)

zozo · 7 Octobre 2019

eriiiic à dit:
Il suffit de coller ça en remplacement de tes lignes :

VB:

With Worksheets("Impression") x = Feuil1.[c16].Value If Len(x) <= 62 Then x = x & "|" Else Mid(x, InStrRev(x, " ", 62), 1) = "|" .[h14:H15] = Application.Transpose(Split(x, "|")) .Activate End With

@Modeste : maligne est le féminin de malin (=astucieuse ;-) )

Merci, problème résolu par patricktoulon.

XL 2010 Chèque

zozo

XLDnaute Occasionnel

Pièces jointes

patricktoulon

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

zozo

XLDnaute Occasionnel

Pièces jointes

zozo

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Jacky67

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Jacky67

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

zozo

XLDnaute Occasionnel

zozo

XLDnaute Occasionnel

Modeste geedee

XLDnaute Barbatruc

eriiic

XLDnaute Barbatruc

Pièces jointes

zozo

XLDnaute Occasionnel

Discussions similaires