pierre4
XLDnaute Occasionnel
bonjour,
j'ai à l'aide
1/ de la première macro
-une numérotation "automatique"+des mise en caractères polices de texte gras hauteur + bordures bas de cellule
à l'aide de la seconde
2/ un report des cellules ci dessus dans un autre onglet
là je demande à la macro: de récuperer les caractères etc et bordures
mon problème, la bordure du bas je n'arrive pas à la reporter sur toute la ligne, elle ne se reporte que dans une cellule et pas celles à coté sur la même lignePourquoi, je ne trouve pas?
merci de votre regard avisé sur les macros ci jointes.
Pierre
1/
2/
j'ai à l'aide
1/ de la première macro
-une numérotation "automatique"+des mise en caractères polices de texte gras hauteur + bordures bas de cellule
à l'aide de la seconde
2/ un report des cellules ci dessus dans un autre onglet
là je demande à la macro: de récuperer les caractères etc et bordures
mon problème, la bordure du bas je n'arrive pas à la reporter sur toute la ligne, elle ne se reporte que dans une cellule et pas celles à coté sur la même lignePourquoi, je ne trouve pas?
merci de votre regard avisé sur les macros ci jointes.
Pierre
1/
Code:
Sub Numérotation()
Dim plage As Range, cel As Range, txt$, n1&, n2&, n3&
'---initialisations---
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set plage = Range("D1:D" & [E65536].End(xlUp).Row)
[D:D].Clear
[E:G].Borders.LineStyle = xlNone
[D:D].HorizontalAlignment = xlLeft
'---construction de la colonne D---
For Each cel In plage
txt = LCase(cel.Offset(, 1)) 'colonne E
If txt = "txlocalisation" Then
cel = n1
cel.RowHeight = 15
cel.Resize(, 4).Font.Size = 13
cel.Resize(, 4).Font.FontStyle = "Gras"
cel.Resize(, 4).Font.ColorIndex = 51
cel.Resize(, 4).Interior.ColorIndex = 35
ElseIf txt = "txpiece" Then
cel = Chr(65 + n1)
n1 = n1 + 1
n2 = 0
cel.RowHeight = 15
cel.Font.FontStyle = "Gras"
cel.Font.Size = 10
cel.Resize(, 4).Font.Size = 11
cel.Resize(, 4).Font.FontStyle = "Gras"
cel.Resize(, 4).Font.ColorIndex = 5
cel.Resize(, 4).Interior.ColorIndex = 34
ElseIf txt = "txtravaux" Then
n2 = n2 + 1
n3 = 1
cel = Chr(64 + n1) & n2 & ".1"
cel.RowHeight = 12
cel.Font.Size = 8
cel.Font.FontStyle = "Gras"
cel.Font.Color = 5
cel.Offset(, 4).Font.Size = 10
cel.Offset(, 4).Font.FontStyle = "Gras"
cel.Resize(, 4).Font.ColorIndex = 3
cel.Resize(, 4).Borders(xlEdgeTop).LineStyle = xlContinuous
ElseIf txt = "libellé" Then
n3 = n3 + 1
cel = Chr(64 + n1) & n2 & "." & n3
cel.Font.Size = 7
cel.Font.ColorIndex = 2
cel.Resize(, 4).Font.Name = "arial"
cel.Resize(, 4).Font.FontStyle = "Gras"
cel.Offset(, 4).Font.ColorIndex = 5
ElseIf txt = "[COLOR="red"][B]st[/B][/COLOR]" Then
cel.RowHeight = 15
cel.Resize(, 5).Font.FontStyle = "Gras"
cel.Font.Size = 10
cel.Resize(, 5).Font.ColorIndex = 11
[COLOR="blue"][B]cel.Resize(, 20).Borders(xlEdgeBottom).LineStyle = xlContinuous[/B][/COLOR]
ElseIf txt = "sp" Then
cel.RowHeight = 40
cel.Font.ColorIndex = 2
Else
cel.Font.Size = 8
cel.Font.ColorIndex = 2
End If
Next
Application.Calculation = xlAutomatic
End Sub
Code:
Sub Devis()
Dim plage As Range, Cellule As Range, Recherche As Range
If ActiveSheet.Name = "Devis" Then
Set plage = ActiveSheet.Range("C18:D500")
Else
Exit Sub
End If
For Each Cellule In plage
If Not Cellule.Value = "" Then
Set Recherche = Sheets("Ouvrages").Range("D:P").Find(Cellule, lookat:=xlWhole)
If Not Recherche Is Nothing Then
Cellule.Font.FontStyle = Recherche.Font.FontStyle
Cellule.Font.Italic = Recherche.Font.Italic
Cellule.Font.Size = Recherche.Font.Size
Cellule.Font.Bold = Recherche.Font.Bold
Cellule.Font.Color = Recherche.Font.Color
Cellule.RowHeight = Recherche.RowHeight
Cellule.Interior.Color = Recherche.Interior.Color
Cellule.Font.ThemeFont = Recherche.Font.ThemeFont
End If
End If
Next Cellule
End Sub
Dernière édition: