Boucle pour insertion de colonne

Résolu
chrispr07 Messages postés 47 Date d'inscription   Statut Membre Dernière intervention   -  
chrispr07 Messages postés 47 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour a vous, ceux qui chaque jour veillent a nous secourir quand rien ne va
merci beaucoup pour votreaide
aujourd'hui je viens encore vers vous pour exposer mon probleme

j'ai un tableau constitué de mois
du coup j'aimerais inserer des semaines pour chaque mois
du coup j'ai ecris un algo qui me permet de le faire
mais le probleme se trouve sur le fait que certains mois se retrouvent avec 5 semaines alors que mon algo ne fait qu'intégrer que 4 semaines donc ajouter trois colonnes

du coup j'ai crée une autre feuille qui renseigne pour chaque mois le nombre de semaine par mois
et je veux creer une boucle qui ira recuperer le nombre de semaines que je vais inserer pour chaque mois
et ce nombre va correspondre au nombre de colonne que je dois inserer



voici mon code de base


Private Sub CommandButton1_Click()


'
' inser Macro
'

'
Application.DisplayAlerts = False
Dim debut, fin, courant As Double
debut = Range("BI3").Column 'Change by what you want
fin = Range("BS3").Column
courant = debut

Do Until courant > fin

'Add three columns
Columns(courant).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(courant).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(courant).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Columns(courant).insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'taille des colonnes
With Range(Cells(1, courant), Cells(1, (courant + 3)))
.ColumnWidth = 4
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With

'merge les colonnes 5 par 5:
Cells(1, courant).Value = Cells(1, (courant + 3)).Value
Range(Cells(1, courant), Cells(1, (courant + 3))).Merge

courant = courant + 4 'j'avance de 4 lignes
fin = fin + 3 'la fin se décale des 3 lignes que j'ai ajoutées

Loop
Application.DisplayAlerts = True

Inser_Column_UserForm1.hide




End Sub


et je veux l'adapter


Quelqu'un peut m'aider?


Merci d'avance a Vous



A voir également:

2 réponses

via55 Messages postés 14512 Date d'inscription   Statut Membre Dernière intervention   2 746
 
Bonsoir

En supposant de mettre le nombre de semaines dans une Feuil2 en B1, B2, B3 etc

Remplacer les 3 lignes de :
Columns(courant).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

par:
x=x+1
sem=sheets("Feuil2").range("B" & x).value
For n= 1 to sem -1
Columns(courant).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next n

puis remplacer :
courant = courant + 4
fin = fin + 3
par :
courant = courant + sem
fin = fin + sem -1

A adapter à ton fichier

Cdlmnt
0
chrispr07 Messages postés 47 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,
Merci , tu me sauve la vie , j'ai essayé de l'adapter
en faisant comme tu l'as dis mais il ya des colonnes qui ne sont pas touchées
" je suis un debutant en programmation"

voici le code


Application.DisplayAlerts = False
Dim x As Integer
Dim sem As Integer
Dim debut, fin, courant As Double
debut = Range("BI3").Column 'Change by what you want
fin = Range("BS3").Column
courant = debut
x = 44
Do Until courant > fin

'Add three columns

sem = Sheets("MyMenuSheet").Range("F" & x).Value
For n = 1 To sem - 1
Columns(courant).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
x = x + 1
Next n
'Columns(courant).insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'taille des colonnes
With Range(Cells(3, courant), Cells(3, (courant + 3)))
.ColumnWidth = 4
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With

'merge les colonnes 5 par 5:
Cells(3, courant).Value = Cells(3, (courant + 3)).Value
Range(Cells(1, courant), Cells(1, (courant + 3))).Merge
courant = courant + sem
fin = fin + sem - 1
Loop
Application.DisplayAlerts = True


Salutations
Chrispr07
0
via55 Messages postés 14512 Date d'inscription   Statut Membre Dernière intervention   2 746
 
Normal que ça bug
Tu n'as pas respecté à la lettre mes indications
le x=x+1 doit être avant
sem = Sheets("MyMenuSheet").Range("F" & x).Value
puisque c'est l'incrementation de cette variable x de 1 à chaque tour de la boucle Do until qui change la reference de la colonne F pour tenir compte du nouveau n° de semaine

Cdlmnt

0
chrispr07 Messages postés 47 Date d'inscription   Statut Membre Dernière intervention  
 
ah ok j'ai fais ce que tu m'as dis , et sa marche
merci encore
tu es un chef

Salutations
0