Découpage de texte
Résolu
vegetalain
Messages postés
747
Date d'inscription
mardi 25 mars 2003
Statut
Membre
Dernière intervention
11 août 2022
-
11 nov. 2008 à 21:17
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 12 nov. 2008 à 06:44
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 12 nov. 2008 à 06:44
5 réponses
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
11 nov. 2008 à 21:49
11 nov. 2008 à 21:49
salut,
tout à fait d'accord, y'a pas de question
bref, comme d'hab : CODYX
<hr />
' SPLIT SELON LE NOMBRE MAX DE CARACTÈRES VOULU, EN TENANT COMPTE DES
RETOURS CHARIOT ET DES CHAÎNES NON-SÉCABLES
' http://www.codyx.org/snippet_split-selon-nombre-max-caracteres-voulu-tenant-compte_448.aspx#1453
' Posté par [ 401740 PCPT ] le 02/09/2007
<hr />
Private Function
SplitNumberChars(
ByVal
sStr
As String
,
ByVal
iCut
As Long
,
Optional
RemoveVbCrLf
As Boolean
=
False
,
Optional
SeparChar
As String
=
"-"
,
Optional
bUseMnemonic
As Boolean
=
False
)
As
String
()
Dim sRet As String, i As Long, lPos As Long, bCR As Boolean, sLine As String
' vire les VBCRLF et les
ESPACE multiples générés
If RemoveVbCrLf Then
sStr = Trim$(Replace(sStr, vbCrLf, " "))
Do While InStr(1, sStr,
" ") <> 0
sStr = Replace(sStr, " ", "
")
Loop
Else
sStr = Replace(sStr, vbCrLf, " " & vbCrLf)
End If
'
traitement
sRet = vbNullString
Do While LenB(sStr) > 0
' retour chariot le plus loin
lPos = InStrRev(Left$(sStr, iCut + 2), vbCrLf)
If lPos = 0 Then
' y'en a pas? on
cherche l'espace le plus loin
lPos = InStrRev(Left$(sStr, iCut + 1), " ")
bCR = False
Else
bCR = True
End If
If lPos = 0 Then
' lpos toujours à
zéro? donc ligne non-sécable
If Len(sStr) > iCut Then
If RemoveVbCrLf Then
sRet = sRet & Left$(sStr, iCut - 1) & SeparChar & vbCrLf
sStr = SeparChar & Mid$(sStr, iCut)
Else
sRet = sRet & Left$(sStr, iCut) & SeparChar &
vbCrLf
sStr = SeparChar & Mid$(sStr, iCut + 1)
End If
Else
sRet = sRet & sStr & vbCrLf
sStr = vbNullString
End If
Else
sLine = Left$(sStr, lPos - 1)
sStr = Right$(sStr, Len(sStr) - Len(sLine) - IIf(bCR, 2, 1))
sRet = sRet & sLine & vbCrLf
End If
Loop
' pas de UseMnemonic?....
If Not bUseMnemonic Then sRet = Replace(sRet, "&", "&&")
'
retour
SplitNumberChars = Split(sRet, vbCrLf)
End Function
'----------------------------------------------------------------
'Remarques :
'permet par exemple de faire un retour à la ligne dès l'espace se
situant avant le 40ème caractère, tout en concervant les retours chariot (ou
non, en option), et de couper les chaînes au 39ème caractère si le mot complet
ne contient pas d'espace (un lien par exemple)
'
'finalité : texte
semi-justifié, tenant compte d'une "pré" mise en page
++
<hr size ="2" width="100%" />
Prenez un instant pour répondre à [sujet-SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
tout à fait d'accord, y'a pas de question
bref, comme d'hab : CODYX
<hr />
' SPLIT SELON LE NOMBRE MAX DE CARACTÈRES VOULU, EN TENANT COMPTE DES
RETOURS CHARIOT ET DES CHAÎNES NON-SÉCABLES
' http://www.codyx.org/snippet_split-selon-nombre-max-caracteres-voulu-tenant-compte_448.aspx#1453
' Posté par [ 401740 PCPT ] le 02/09/2007
<hr />
Private Function
SplitNumberChars(
ByVal
sStr
As String
,
ByVal
iCut
As Long
,
Optional
RemoveVbCrLf
As Boolean
=
False
,
Optional
SeparChar
As String
=
"-"
,
Optional
bUseMnemonic
As Boolean
=
False
)
As
String
()
Dim sRet As String, i As Long, lPos As Long, bCR As Boolean, sLine As String
' vire les VBCRLF et les
ESPACE multiples générés
If RemoveVbCrLf Then
sStr = Trim$(Replace(sStr, vbCrLf, " "))
Do While InStr(1, sStr,
" ") <> 0
sStr = Replace(sStr, " ", "
")
Loop
Else
sStr = Replace(sStr, vbCrLf, " " & vbCrLf)
End If
'
traitement
sRet = vbNullString
Do While LenB(sStr) > 0
' retour chariot le plus loin
lPos = InStrRev(Left$(sStr, iCut + 2), vbCrLf)
If lPos = 0 Then
' y'en a pas? on
cherche l'espace le plus loin
lPos = InStrRev(Left$(sStr, iCut + 1), " ")
bCR = False
Else
bCR = True
End If
If lPos = 0 Then
' lpos toujours à
zéro? donc ligne non-sécable
If Len(sStr) > iCut Then
If RemoveVbCrLf Then
sRet = sRet & Left$(sStr, iCut - 1) & SeparChar & vbCrLf
sStr = SeparChar & Mid$(sStr, iCut)
Else
sRet = sRet & Left$(sStr, iCut) & SeparChar &
vbCrLf
sStr = SeparChar & Mid$(sStr, iCut + 1)
End If
Else
sRet = sRet & sStr & vbCrLf
sStr = vbNullString
End If
Else
sLine = Left$(sStr, lPos - 1)
sStr = Right$(sStr, Len(sStr) - Len(sLine) - IIf(bCR, 2, 1))
sRet = sRet & sLine & vbCrLf
End If
Loop
' pas de UseMnemonic?....
If Not bUseMnemonic Then sRet = Replace(sRet, "&", "&&")
'
retour
SplitNumberChars = Split(sRet, vbCrLf)
End Function
'----------------------------------------------------------------
'Remarques :
'permet par exemple de faire un retour à la ligne dès l'espace se
situant avant le 40ème caractère, tout en concervant les retours chariot (ou
non, en option), et de couper les chaînes au 39ème caractère si le mot complet
ne contient pas d'espace (un lien par exemple)
'
'finalité : texte
semi-justifié, tenant compte d'une "pré" mise en page
++
<hr size ="2" width="100%" />
Prenez un instant pour répondre à [sujet-SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
jmf0
Messages postés
1566
Date d'inscription
mardi 26 décembre 2000
Statut
Membre
Dernière intervention
5 avril 2013
8
11 nov. 2008 à 21:24
11 nov. 2008 à 21:24
Bonjour,
"J'avais pensé "inséter" un vbcrlf tous les dix caractères mais..."
"Mais" quoi, exactement ?
Mais tu ne sais pas faire ?
ou
Mais tu t'interroges sue le fait que ce choix est bon ?
"Mais"...tout seul ne veut pas dire grand chose !
"J'avais pensé "inséter" un vbcrlf tous les dix caractères mais..."
"Mais" quoi, exactement ?
Mais tu ne sais pas faire ?
ou
Mais tu t'interroges sue le fait que ce choix est bon ?
"Mais"...tout seul ne veut pas dire grand chose !
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
11 nov. 2008 à 21:57
11 nov. 2008 à 21:57
,... pour la démo :
Private Sub
Form_Load()
Const s As String = "qmskljehrgpoeirpoaieprogaihpozeihpfoaihezpoihffgkd"
Dim i As Integer
Dim asLines() As String
asLines = SplitNumberChars(s, 10, , vbNullString)
For i = 0 To UBound(asLines)
Debug.Print asLines(i)
Next i
End Sub
<small>
[../code.aspx?ID=39466 Coloration VB6, VBA,
VBS]
</small>
Private Sub
Form_Load()
Const s As String = "qmskljehrgpoeirpoaieprogaihpozeihpfoaihezpoihffgkd"
Dim i As Integer
Dim asLines() As String
asLines = SplitNumberChars(s, 10, , vbNullString)
For i = 0 To UBound(asLines)
Debug.Print asLines(i)
Next i
End Sub
<small>
[../code.aspx?ID=39466 Coloration VB6, VBA,
VBS]
</small>
vegetalain
Messages postés
747
Date d'inscription
mardi 25 mars 2003
Statut
Membre
Dernière intervention
11 août 2022
12 nov. 2008 à 06:38
12 nov. 2008 à 06:38
mais je ne sais pas quoi faire. Merci j'aurais pa trouvé ça tout seul... :/
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
12 nov. 2008 à 06:44
12 nov. 2008 à 06:44
reste plus qu'à valider alors....