remplir zone de cellules avec du texte

  • Initiateur de la discussion joris
  • Date de début
J

joris

Guest
Bonjour a tous,

je vous met en fichier join un petit exemple de ce que je voudrais faire car cela est plus parlant.
Dans la sheet2 vous avez du texte que je voudrais faire passer dans le cadre de la sheet1. La taille du cadre de la sheet1 ne peut pas bouger et je voudrais que le texte ne sorte pas comme actuellement du tableau.


Pouvez vous m'aider en me disant les fonctions a utiliser: j'ai pense a resize ou autoFit, wraptext mais je sais pas si c'est reelement la solution.

Merci de votre aide

Joris

PS: j'esperes qu'il n'y a plus de pb avec les pices jointes
 
J

Jocelyn

Guest
Salut le Forum,
Salut joris,

J'ais repris ton fichier et j'ai changer la macro et aussi le lieu de recopie j'effectue le cadre sur une seule cellule mais plus large.

J'ai laisse ton fichier dans le meme apercu a l'ouverture, voir fichier joint

si tu lance ta macro ca devrait fonctionner,

en espérant avoir répondu a ta demande

A+
Jocelyn
 
J

joris

Guest
Bonjour Jocelyn, le forum,
Merci Jocelyn tu m'avances beaucoup.
Le seul petit probleme qui subsiste c'est que la taille du cadre ne doit pas changer aussi en hauteur.
Je sais pas comment faire. Il doit falloir reperer la taille avant de faire le transfert et trouver un moyen de le laisser fixe meme en changeant la hauteur de certaines cellule...

si vous avez une idee

Merci

Joris
 
M

Myta

Guest
Bonsoir le Forum

Regarde si ceci pourrait t'aider vite fait d'une macro de Alan Beban

Sub Coupe_60Car()

iTotal = Mid(Sheets("Sheet2").Range("A1"), k + 1, 1000) & " "
For j = 2 To 100
For i = 60 To 1 Step -1
If Mid(iTotal, i, 1) = " " Then
k = i
Exit For
End If
Next
Sheets("Sheet1").Cells(j, 1).Value = Mid(iTotal, 1, k - 1)
iTotal = Mid(iTotal, k + 1, 1000)
Next

End Sub


Mytå
 
J

Jocelyn

Guest
Salut le forum,
salut Myta,
Salut Joris,

ton plus gros probleme en y regardant de plus près c'est que l'espace utilisé dans sheet 2 est plus important que celui que tu as reservé dans sheet 1.
Pour l'instant je vois pa bien comment faire j'y réflechi.

dit moi Myta, je fais partie de ce que l'on appelle les débutants pourrais tu nous explicité ta macro j'arrive pas a tout décoder.

merci a toi Myta
et toi Jaris j'essai de voir.

A+
Jocelyn
 
J

joris

Guest
merci jocelyn pour ton aide,


myta je n'ai pas compris tout ton code non plus. je suis debutant aussi.

Jocelyn la c'est juste un exemple normallement il devrait pas y avoir de probleme de taille. De plus tu as changer un petit truc par rapport au fichier de depart c'est qu'avant le texte ne devait pas se mettre uniquement dans la colonne A mais dans les colonnes de A a F se qui complique encore le probleme.

Je continu a chercher de mon cote.

Le truc vraiment embettant c'est que je peux pas changer cette structure car c'est pas la mienne. Moi je dois juste remplir cette structure. De plus ce cadre est compris dans une page donc si j'agrandi les lignes comme tu l'as fait tout se decalle, c'est pourquoi je voulais grader la meme hauteur. Ca me parait difficile.

L'autre idee serait de decouper le texte de la longueur de la case et passe a la ligne a chaque fois.

Joris
 
M

myDearFriend

Guest
Bonjour tout le monde,

Joris, "L'autre idee serait de decouper le texte de la longueur de la case et passe a la ligne a chaque fois."...

C'est exactement l'objet de la procédure de Myta !

Si tu l'essayes, tu verras qu'elle recopie en Sheet1 le texte de la cellule "A1" de la Sheet2 en découpant la phrase par "tranches" de 60 caractères (sans couper les mots !).

Il ne te reste plus qu'à l'adapter à ton propre code...

Cordialement.
Didier_mDF
 
M

Myta

Guest
Re bonjour Joris, Jocelyn et Didier

Une autre approche a voir :

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

Mytå
 

Discussions similaires

Réponses
22
Affichages
991

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib