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

reporter une bordure d'un onglet à un autre à l'aide d'une macro

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/
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
2/
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:

Staple1600

XLDnaute Barbatruc
Re : reporter une bordure d'un onglet à un autre à l'aide d'une macro

Bonsoir


Je me permets un conseil en temps que voisin

Utilises les balises CODE pour rendre ton message plus lisible

Comment?
Sélectionne ton code VBA dans ton message et cliques sur cet icône :

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
C'est plus mieux ainsi non ?

Une suggestion de syntaxe pour éviter les redondances dans le code
Code:
With cel.Resize(, 4)
.Interior.ColorIndex = 35
With .Font: .Size = 13: .FontBold = True: .ColorIndex = 51: End With
End With
 

Pièces jointes

  • code.png
    463 bytes · Affichages: 172
  • code.png
    463 bytes · Affichages: 171
Dernière édition:

Hippolite

XLDnaute Accro
Re : reporter une bordure d'un onglet à un autre à l'aide d'une macro

Bonsoir à tous,
Je vois que tu utilises Find, cette méthode a une particularité qu'il faut connaître :
Les paramètres de Find, LookIn, LookAt, SearchOrder, MatchByte et de la boîte de dialogue Rechercher sont sauvegardés à chaque utilisation. Si des arguments sont omis, les valeurs enregistrées, qui sont communes, seront utilisées au prochain appel de la méthode, elles peuvent donc avoir été modifiées.
En conséquence, pour éviter les problèmes, il faut définir tous les arguments explicitement à chaque fois que cette méthode est utilisée ou bien réinitialiser les paramètres avec Application.FindFormat.Clear
A+
 

pierre4

XLDnaute Occasionnel
bonjour mon voisin Stapple et Hippolyte!
merci de votre aide;(maintenant je sais afficher une formule : plus clair non! (merci Stapple!)
Stapple, j'ai une erreur sur ce que tu m'a mis après l'avoir essayé
je vais regarder cela de plus près plus tard...

Hippolyte: ou dois je mettre --- Application.FindFormat.Clear???
car pour moi le VBA = découverte à partir de rien

merci

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
 

Staple1600

XLDnaute Barbatruc
Re : reporter une bordure d'un onglet à un autre à l'aide d'une macro

Bonjur


Une erreur de frappe
J'ai pas été assez vigilant avec mes endives
Code:
With cel.Resize(, 4)
.Interior.ColorIndex = 35
With .Font: .Size = 13: .Bold = True: .ColorIndex = 51: End With
End With
 

pierre4

XLDnaute Occasionnel
bordure basse de celule

Merci Stapple!
bonne journée

avez vous l'idée pour ma bordure basse qui ne se reporte pas sur toute la ligne??


Hippolyte: ou dois je mettre --- Application.FindFormat.Clear???
a+
 

Staple1600

XLDnaute Barbatruc
Re : reporter une bordure d'un onglet à un autre à l'aide d'une macro

Re

Quand je teste ceci
Code:
Sub test()
ActiveCell.Resize(, 20).Borders(9).LineStyle = 1
End Sub
La bordure s'applique bien

Le problème est donc ailleurs dans le code

Pou info
9=xlEdgeBottom
1=xlContinuous

PS: tu peux éditer ton premier message, stp, et y appliquer la balise CODE
Comme cela ton fil de discussion sera tout beau tout propre
 

pierre4

XLDnaute Occasionnel
Re : reporter une bordure d'un onglet à un autre à l'aide d'une macro

Merci Hippolite et Stapple,
pour Hippolite c'est ok
pour Stapple j'ai essayé sur fichier brouillon oui
sur le mien non! je vais regarder cela de plus prêt
merci à vous
bonne journée.
Pierre
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…