Mise en page feuilles nom feuille pas connu
Bonjour à tous.
Je me permets de reposer une nouvelle question suite à une nouvelle interrogation.
Alors voilà j'ai réussi à créer des nouvelles feuilles en fonction d'une liste. Le soucis, c'est que j'aimerais que chaque nouvelles feuilles ai une mise en page particulière.
J'ai réussi à créer ma mise en page (approximativement) via VBA mais le soucis c'est que je ne connais pas le nom des feuilles qui sont créer (et donc n'arrive pas à sélectionner telle ou telle cellule pour lui appliquer un style, une couleur, ...).
Je vous mets mes 2 codes :
- celui de la création des feuilles
Sub Macro_ajoutfeuille()
'
' Macro_ajoutfeuille Macro
'
Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Page de garde").Range("E31")
While curCell.Value <> vbNullString
ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value & " "
ThisWorkbook.Sheets("Page de garde").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
"'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!E30", TextToDisplay:="Acces Feuille"
Set curCell = curCell.Offset(1, 0)
Wend
ThisWorkbook.Sheets("Page de garde").Select
'
End Sub
- celui de la mise en page
Range("B2").Select
ActiveCell.FormulaR1C1 = "=Feuil1!R[29]C"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=Feuil1!R[24]C[1]"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=Feuil1!R[24]C[-1]"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Prise de contact"
Range("C4").Select
ActiveCell.FormulaR1C1 = "Date"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Interlocuteur"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Contenu"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Perso"
Range("B4:F4").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 52479
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
With Selection.Font
.ThemeColor = xlThemeColorDark2
.TintAndShade = -0.749992370372631
End With
With Selection.Font
.ThemeColor = xlThemeColorDark2
.TintAndShade = -0.749992370372631
End With
Columns("B:B").EntireColumn.AutoFit
Columns("D:D").ColumnWidth = 14.14
Columns("E:E").ColumnWidth = 42
Columns("F:F").ColumnWidth = 56.43
Columns("F:F").ColumnWidth = 52.43
Range("B4:F4").Select
Range("F4").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Rows("4:4").RowHeight = 30.75
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Size = 12
Range("B4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
Merci d'avance pour votre aide.
J'obtiens quelque chose dans ce genre mais :
Dim i%
Dim j%
Dim T1$()
Dim T2$()
Dim S As Worksheet
Dim bool As Boolean
On Error GoTo fin
For Each S In ActiveWindow.SelectedSheets
i% = i% + 1
ReDim Preserve T1$(1 To i%)
T1$(i%) = S.Name
Next S
If Worksheets.Count = UBound(T1$) Then Exit Sub
For Each S In Worksheets
bool = True
For i% = 1 To UBound(T1$)
If S.Name = T1$(i%) Then
bool = False
Exit For
End If
Next i%
If bool Then
ReDim Preserve T2$(0 To j%)
T2$(j%) = S.Name
j% = j% + 1
End If
Next S
Sheets(T2$).Select
fin:
' pour sélectionner les feuilles créées
Columns("A:A").ColumnWidth = 5
Range("B2").Select
ActiveCell.FormulaR1C1 = "='Page de garde'!R[29]C[-1]"
Range("C2").Select
ActiveCell.FormulaR1C1 = "='Page de garde'!R[29]C[-1]"
Range("E2").Select
ActiveCell.FormulaR1C1 = "='Page de garde'!R[24]C[-2]"
Range("F2").Select
ActiveCell.FormulaR1C1 = "='Page de garde'!R[24]C[-1]"
Range("C2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B2:F2").Select
Range("F2").Activate
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Size = 12
Rows("2:2").RowHeight = 21.75
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 52479
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("F:F").ColumnWidth = 22.43
Range("B2:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C4").Select
ActiveCell.FormulaR1C1 = "type de contact"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Date"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Interlocuteur"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Contenu"
Range("G4").Select
ActiveCell.FormulaR1C1 = "Perso"
Range("C5").Select
Columns("C:C").ColumnWidth = 14.57
Range("C2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").ColumnWidth = 15.14
Columns("E:E").ColumnWidth = 20.57
Columns("F:F").ColumnWidth = 31
Columns("G:G").ColumnWidth = 24.14
Range("C4:G4").Select
Range("G4").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 52479
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Font.Bold = True
Selection.Font.Size = 12
Rows("4:4").RowHeight = 30
Range("C4:G4").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C5:G11").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDot
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Reste juste 2 soucis.
- la largeur des cellules que je met en page ne s'ajuste que pour la première feuille, pas pour les suivantes
- de B31 à B45 il y a des numeros. Il est impératif que le numéro en B31 s'affiche dans la feuille 1, le B32 en feuille 2 et ainsi de suite.
Comment ajuster ce code pour que mes 2 petits problèmes s'envolent ?
Je viens de me rendre compte d'un autre gros problème.
Lorsque je remplie le tableau qui s'est crée dans l'une des nouvelles feuilles, il se remplie de manière identique dans toutes les autres feuilles...
Toujours personne pour me donner un petit coup de main