Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Simplifier le code

Myst

XLDnaute Occasionnel
Bonjour le forum
Je voudrais simplifier le code qui comporte plus de 250 lignes
merci
 

Pièces jointes

  • Essai V1.xlsm
    32 KB · Affichages: 65

laetitia90

XLDnaute Barbatruc
bonjour Myst ,Loup solitaire

"brut" comme je comprends???

Code:
[A4:J140].ClearContents
[A4] = TextBox1.Value
z = 5: j = 1
For i = 6 To 135
If Me("TextBox" & i) <> "" Then
Cells(z, 2) = Me("TextBox" & i).Value
z = z + 1
End If
If i = 31 Or i = 57 Or i = 83 Or i = 109 Then
j = j + 1
z = z + 1: Cells(z - 1, 1) = Me("TextBox" & j).Value
End If
Next i
 

Myst

XLDnaute Occasionnel
Bonjour Lone-wolf, laetitia90
Merci de votre intérêt, ci dessous le descriptif de ce que je veux avoir comme résultat
Je clique sur le CommandButton1
1-Le texte du TexBox1 est enregistré dans la cellule A4 de la Feuil "ESSAI"
2-Les TextBox6 a 31 si elles contiennent du texte sont enregistrées dans la dernière ligne vide en colonne "B" (a partir de "B5")
3-Le texte du TextBox2 est enregistré dans la dernière ligne vide en colonne "A"
4-Les TextBox32 a 57 si elles contiennent du texte sont enregistrées dans la dernière ligne vide en colonne "B"
5-Le texte du TextBox3 est enregistré dans la dernière ligne vide en colonne "A"
6-Les TextBox58 a 83 si elles contiennent du texte sont enregistrées dans la dernière ligne vide en colonne "B"
7-Le texte du TextBox4 est enregistré dans la dernière ligne vide en colonne "A"
8-Les TextBox84 a 109 si elles contiennent du texte sont enregistrées dans la dernière ligne vide en colonne "B"
9-Le texte du TextBox5 est enregistré dans la dernière ligne vide en colonne "A"
10-Les TextBox110 a 130 si elles contiennent du texte sont enregistrées dans la dernière ligne vide en colonne "B"
Merci
 

Lone-wolf

XLDnaute Barbatruc
Bonjour Myst

Si j'ai bien compris,

COL A ---------------- COL B
TITRE1 ----------------- 6
TITRE2 ----------------7
TITRE3 ----------------- 8
TITRE4 ----------------- 9
TITRE5----------------- 10 etc.

ça me pararaît bizarre ; pour moi Titre(x) devraient être en entête, je ne vois pas ce que tu cherche à faire. Sinon as-tu fait un test avec la macro proposée par laetitia?
 
Dernière édition:

Myst

XLDnaute Occasionnel
Re
En faite les titres sont plutôt des sous-titres
Comme dans l'aperçu ci dessous et oui j'ai essayé le code mais je ne suis pas arrivé a l'exploité
 

Pièces jointes

  • MystV2.jpg
    110.8 KB · Affichages: 49

Lone-wolf

XLDnaute Barbatruc
Re

Mais c'est ce que font les deux macros proposées. Et il y a 135 TextBox non 130, les 6 dernières sont mal positionnées.

EDIT: En image le résultat de la macro de laetitia.





En PJ, le fichier avec la macro.
 

Pièces jointes

  • Essai V2.xlsm
    29.2 KB · Affichages: 51
Dernière édition:

Myst

XLDnaute Occasionnel
Re
C'est ça, parfait, un grand merci a vous deux
Juste une dernière chose, je voudrais colorier en gris chaque cellules titre plus une située a leurs droite sous forme de macro et non une MFC
Exemple :
A4 + B4
A31 + B31
A42 + B42
etc.
 

Lone-wolf

XLDnaute Barbatruc
Re Myst

Pas besoin, voici la macro modifiée.

VB:
Option Explicit

Dim Z As Long, J As Long, i As Long

Private Sub CommandButton1_Click()

With Sheets("ESSAI")
  .[A4:J140].ClearContents
  .[A4:J140].Interior.ColorIndex = xlNone
  .[A4:J140].Font.Color = vbBlack
  
  .[A4] = TextBox1.Value
  .[A4].Font.Color = RGB(192, 0, 0)
  .[A4].HorizontalAlignment = xlCenter

  Z = 5: J = 1
  For i = 6 To 135
  If Me("TextBox" & i) <> "" Then
  .Cells(Z, 2) = Me("TextBox" & i).Value
  Z = Z + 1
  .Range(.Cells(4, 1), .Cells(4, 2)).Interior.Color = RGB(239, 239, 239)
  End If
  If i = 31 Or i = 57 Or i = 83 Or i = 109 Then
  J = J + 1
  Z = Z + 1: .Cells(Z - 1, 1) = Me("TextBox" & J).Value
  End If
  If i = 31 Or i = 58 Or i = 85 Or i = 112 Then
  .Cells(i, 1).HorizontalAlignment = xlCenter
  .Cells(i, 1).Font.Color = RGB(192, 0, 0)
  .Range(.Cells(i, 1), .Cells(i, 2)).Interior.Color = RGB(239, 239, 239)
  End If
  Next i
  End With
  Userform1.Hide
End Sub
 
Dernière édition:
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…