P
pepi
Guest
Bonjour Forum,
pouvez-vous m'aider?
J'ai un USF dans lequel un TextBox dans lequel j'écris un texte plus au moins longue.
Par un bouton je veux copier ce texte dans un plage de cellules allant de B22 à E23.
Ces cellulles ne sont pas fusionnées car j'ai besoin de protéger certaines celulles -et donc les rendre "intouchables" -en laissant "remplissables" d'autres. Si j'ai des cellules fusionnées, ce manoeuvre ne marche pas.
Je voudrais que le texte commence en B22, continue sur C22 etc jusqu'à E22. Là si le texte continue encore, il doit reprendre en B23 etc..
J'ai trouvé un code de Myta qui doit être un début mais ceci ne marche pas tout à fait pour moi
Sub CoupeTexte()
Dim NbMax As Byte
Dim Ligne As Byte
Dim Texte As Byte
Dim Coupure As Byte
Dim MonTexte As String
NbMax = 60 'Nbre de caractères par cellule désiré
Ligne = 2 'Ligne de début pour écriture
Sheets("Sheet1").Range("A2:F23").ClearContents
For Texte = 1 To 3
MonTexte = Sheets("Sheet2").Range("A" & Texte)
Do While Len(MonTexte) > NbMax + 1
Coupure = InStr(NbMax, MonTexte, " ", vbTextCompare)
If Coupure = 0 Then Exit Do
Sheets("Sheet1").Range("A1").Offset(Ligne, 0) = Left(MonTexte, Coupure - 1)
MonTexte = Mid(MonTexte, Coupure + 1)
Ligne = Ligne + 1
Loop
Sheets("Sheet1").Range("A1").Offset(Ligne, 0) = MonTexte
Ligne = Ligne + 2 'Mettre 1 si on ne veut pas d'espaces entre les textes
Next Texte
End Sub
avez vous des idées?
Bien à vous
pepi
pouvez-vous m'aider?
J'ai un USF dans lequel un TextBox dans lequel j'écris un texte plus au moins longue.
Par un bouton je veux copier ce texte dans un plage de cellules allant de B22 à E23.
Ces cellulles ne sont pas fusionnées car j'ai besoin de protéger certaines celulles -et donc les rendre "intouchables" -en laissant "remplissables" d'autres. Si j'ai des cellules fusionnées, ce manoeuvre ne marche pas.
Je voudrais que le texte commence en B22, continue sur C22 etc jusqu'à E22. Là si le texte continue encore, il doit reprendre en B23 etc..
J'ai trouvé un code de Myta qui doit être un début mais ceci ne marche pas tout à fait pour moi
Sub CoupeTexte()
Dim NbMax As Byte
Dim Ligne As Byte
Dim Texte As Byte
Dim Coupure As Byte
Dim MonTexte As String
NbMax = 60 'Nbre de caractères par cellule désiré
Ligne = 2 'Ligne de début pour écriture
Sheets("Sheet1").Range("A2:F23").ClearContents
For Texte = 1 To 3
MonTexte = Sheets("Sheet2").Range("A" & Texte)
Do While Len(MonTexte) > NbMax + 1
Coupure = InStr(NbMax, MonTexte, " ", vbTextCompare)
If Coupure = 0 Then Exit Do
Sheets("Sheet1").Range("A1").Offset(Ligne, 0) = Left(MonTexte, Coupure - 1)
MonTexte = Mid(MonTexte, Coupure + 1)
Ligne = Ligne + 1
Loop
Sheets("Sheet1").Range("A1").Offset(Ligne, 0) = MonTexte
Ligne = Ligne + 2 'Mettre 1 si on ne veut pas d'espaces entre les textes
Next Texte
End Sub
avez vous des idées?
Bien à vous
pepi