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

pierre4

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:
Trier par date Trier par votes
Staple1600

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.png

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
    code.png
    463 bytes · Affichages: 171
  • code.png
    code.png
    463 bytes · Affichages: 170
Dernière édition:
Vote positif 0 Vote négatif
Hippolite

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+
 
Vote positif 0 Vote négatif
pierre4

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
 
Vote positif 0 Vote négatif
Staple1600

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
 
Vote positif 0 Vote négatif
Staple1600

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 :)
 
Vote positif 0 Vote négatif
pierre4

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
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL 2021 message si une valeur n'existe pas
Réponses
6
Affichages
451
target
T
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
395
un internaute
U
S
  • Question
XL 2016 Code de transfert
Réponses
8
Affichages
768
Seddiki_adz
S
P
  • Question
Microsoft 365 Problème de destination à l'exécution d'une macro
Réponses
2
Affichages
305
Pimpon974
P
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
604
Phil69970
Phil69970
P
  • Résolu(e)
Microsoft 365 Erreur d'exécution "9" :L'indice n'appartient pas à la sélection
Réponses
9
Affichages
1 K
pelerin65
P
A
  • Question
XL 2021 Résultats dans un formulaire VBA suite à la saisie d'un texte contenu dans un tableau Excel
Réponses
10
Affichages
501
AugusteP
A
marg55
  • Question
XL 2016 Variable d'un module de classe à un autre
Réponses
3
Affichages
475
marg55
marg55
D
  • Question
XL 2019 Aide à la compréhension d'un code VBA
Réponses
4
Affichages
741
Dudu2
Dudu2
Etoto
  • Résolu(e)
Microsoft 365 Code VBA qui renvoie une matrice à partir d'un liste à cocher au lieu d'une cellule
Réponses
5
Affichages
607
yal
Y

Membres actuellement en ligne

24 membres et 437 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 461
Messages
2 088 611
Membres
103 890
dernier inscrit
rugbymen79