XL 2019 texte et bordure bouton vba

frederio · 11 Juillet 2025

Bonjour à tous
Tu vous connais comment faire ?
Si tu veux être d’accord avec moi ??? vous m’aidez a expliqué comme Excel Merci

la feuille (Belgique)

Pour appliquer à notre texte l'une de blanc et une bordure à la cellule active avec blanc bouton vba

sur "AM20:AV21"

Pour appliquer à notre texte l'une de blanc et une bordure à la cellule active avec blanc bouton vba sur " D12+F12:I12+K12" (Suite la journée 1- 30) base texte et bordure blanc

Retour noir

Pour appliquer à notre texte l'une de noir et une bordure à la cellule active avec noir bouton vba

sur "AM20:AV21"

Pour appliquer à notre texte l'une de noir et une bordure à la cellule active avec noir bouton vba sur " D12+F12:I12+K12" (Suite la journée 1- 30) base texte et bordure noir

Reste couleur RGB (198, 224, 180)
(Suite la journée 1- 30)

job75 · 13 Juillet 2025

Bon OK il suffit de masquer les lignes :

VB:

Sub Masquer()
Application.ScreenUpdating = False
Afficher
[D333:K375].EntireRow.Hidden = True 'masque les lignes
With [D:K]
    .FormatConditions.Add xlExpression, Formula1:="=($F1=""A"")+($F1=""B"")"
    .FormatConditions(1).Interior.Color = vbWhite
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeLeft).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeBottom).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeRight).Color = vbWhite
End With
With [AM:AV]
    .FormatConditions.Add xlExpression, Formula1:="=($AN1=""A"")+($AN1=""B"")"
    .FormatConditions(1).Interior.Color = vbWhite
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeLeft).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeBottom).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeRight).Color = vbWhite
End With
End Sub

Sub Afficher()
On Error Resume Next
[D:K,AM:AV].FormatConditions.Delete
Rows.Hidden = False 'affiche toutes les lignes
End Sub

frederio · 13 Juillet 2025

c est parfait 🙂 merci

job75 · 13 Juillet 2025

Le masquage des lignes de la plage D333:K375 prend du temps => environ 0,3 seconde chez moi (je ne sais pas pourquoi).

Il existe un moyen bien plus simple et bien plus rapide => modifier la formule de la MFC de la plage D:K :

VB:

Sub Masquer()
Application.ScreenUpdating = False
Afficher
With [D:K]
    .FormatConditions.Add xlExpression, Formula1:="=$F2="""""
    .FormatConditions(1).Interior.Color = vbWhite
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeLeft).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeBottom).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeRight).Color = vbWhite
End With
With [AM:AV]
    .FormatConditions.Add xlExpression, Formula1:="=($AN2="""")+($AN3="""")"
    .FormatConditions(1).Interior.Color = vbWhite
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeLeft).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeBottom).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeRight).Color = vbWhite
End With
End Sub

Sub Afficher()
On Error Resume Next
[D:K,AM:AV].FormatConditions.Delete
End Sub

En D:K la MFC traite une ligne quand la ligne du dessous est vide.

Edit : j'ai aussi modifié dans le même esprit la formule de la MFC de la plage AM:AV.

frederio · 14 Juillet 2025

Bonjour job 75 . Tu es oublie regarde bien il l'a confirmé en samedi à 12 :45 et 12 :56 :

https://excel-downloads.com/threads/texte-et-bordure-bouton-vba.20087714/#post-20694025

https://excel-downloads.com/threads/texte-et-bordure-bouton-vba.20087714/#post-20694027

job75 · 15 Juillet 2025

Bonjour frederio,

Il suffit d'agrandir la plage de la 2ème MFC :

VB:

Sub Masquer()
Application.ScreenUpdating = False
Afficher
With [D:K]
    .FormatConditions.Add xlExpression, Formula1:="=$D2="""""
    .FormatConditions(1).Interior.Color = vbWhite
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeLeft).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeBottom).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeRight).Color = vbWhite
End With
With [AM:BE]
    .FormatConditions.Add xlExpression, Formula1:="=($AM2="""")+($AM3="""")"
    .FormatConditions(1).Interior.Color = vbWhite
    .FormatConditions(1).Font.Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeLeft).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeBottom).Color = vbWhite
    .FormatConditions(1).Borders(xlEdgeRight).Color = vbWhite
End With
End Sub

Sub Afficher()
On Error Resume Next
[D:K,AM:BE].FormatConditions.Delete
End Sub

A+

frederio · 15 Juillet 2025

problème tu voir

job75 · 15 Juillet 2025

Comme vous ne voulez pas vous fatiguer je ne me fatigue pas non plus.

AtTheOne · 19 Juillet 2025

Bonjour à toutes & à tous, bonjour @frederio,
Je vois que tu as fini par décourager notre ami Job75 avec tes réponses minimalistes et répétitives.
Pourquoi, comme ton français n'est pas très bon, n'utilises-tu pas Google traduction comme moi ici pour rédiger des messages plus complets ?
Ik zie dat je onze vriend Job75 eindelijk hebt ontmoedigd met je minimalistische en repetitieve antwoorden.
Waarom, aangezien je Frans niet zo goed is, gebruik je Google Translate niet zoals ik hier doe om uitgebreidere berichten te schrijven?
Bon voici une proposition, sans me soucier de la rapidité pour répondre à tes demandes précédentes (ou du moins ce que j'en ai compris)
À bientôt

Code :

VB:

Sub Masquer()
     Dim WSh As Worksheet, rg As Range, Ligne As Range, Blanc As Long, Noir As Long, Vert1 As Long, Vert2 As Long, i As Long
   
     Blanc = RGB(255, 255, 255)
     Noir = RGB(0, 0, 0)
     Vert1 = RGB(226, 239, 218)
     Vert2 = RGB(198, 224, 180)
   
     Set WSh = Sh_Belgique
   
     'Tableau de classement
     Set rg = WSh.[AM4:BE21]
     Application.ScreenUpdating = False
     For Each Ligne In rg.Rows
          With Ligne
               If Len(.Cells(2) & "") = 1 Then
                    .Borders(xlInsideVertical).LineStyle = xlNone
                    .Borders(xlEdgeLeft).LineStyle = xlNone
                    .Borders(xlEdgeRight).LineStyle = xlNone
                    .Borders(xlEdgeBottom).LineStyle = xlNone
                    .Interior.Pattern = xlNone
                    .Font.Color = Blanc
               End If
          End With
     Next Ligne
   
     'Résultats des journées
     Set rg = WSh.[D3:K376]
     'Masquer les équipes non renseignées (nom = 1 lettre)
     With rg
          For i = 1 To 374
               If Len(.Cells(i, 3) & "") = 1 Then
                    With .Rows(i)
                         .Borders(xlInsideVertical).LineStyle = xlNone
                         .Borders(xlEdgeLeft).LineStyle = xlNone
                         .Borders(xlEdgeRight).LineStyle = xlNone
                         .Borders(xlEdgeBottom).LineStyle = xlNone
                         .Interior.Pattern = xlNone
                         .Font.Color = Blanc
                    End With
               End If
          Next i
     End With
     'Masquer les journées vides
     For i = 1 To 374 Step 11
          If rg.Cells(i + 1, 1) = "" Then
               With rg.Rows(i).Resize(11)
                    .Interior.Color = Blanc
                    .Font.Color = Blanc
                    .Borders.LineStyle = xlNone
               End With
          End If
     Next i
     Application.ScreenUpdating = True
   
End Sub

Sub Afficher()
   
     Dim WSh As Worksheet, rg As Range, Ligne As Range, Blanc As Long, Noir As Long, Vert1 As Long, Vert2 As Long, i As Long
   
     Blanc = RGB(255, 255, 255)
     Noir = RGB(0, 0, 0)
     Vert1 = RGB(226, 239, 218)
     Vert2 = RGB(198, 224, 180)
   
     Set WSh = Sh_Belgique
   
     Application.ScreenUpdating = False
   
     'Tableau de classement
     Set rg = WSh.[AM4:BE21]
     For Each Ligne In rg.Rows
          With Ligne
               If Len(.Cells(2) & "") = 1 Then
                    With .Resize(1, 10)
                         .Borders.LineStyle = xlContinuous
                         .Interior.Pattern = xlNone
                         .Font.Color = Noir
                    End With
                    With .Cells(12).Resize(, 2)
                         .Borders.LineStyle = xlDot
                         .Borders(xlInsideVertical).LineStyle = xlNone
                         .Font.Color = Noir
                    End With
                    With .Cells(15).Resize(, 5)
                         .Borders.LineStyle = xlDot
                         .Font.Color = Noir
                    End With
               End If
          End With
     Next Ligne
   
     'Résultats des journées
     Set rg = WSh.[D3:K376]
     'Afficher les équipes non renseignées (nom = 1 lettre)
     With rg
          For i = 1 To 374
               If Len(.Cells(i, 3) & "") = 1 Then
                    With Union(.Cells(i, 1), .Cells(i, 8))
                         .Font.Color = Noir
                         .Interior.Color = Vert2
                    End With
                    With .Cells(i, 3).Resize(, 4)
                         .Font.Color = Noir
                         .Interior.Color = IIf(i Mod 2 = 0, Vert2, Vert1)
                         .Borders(xlInsideVertical).LineStyle = xlContinuous
                         .Borders(xlEdgeLeft).LineStyle = xlContinuous
                         .Borders(xlEdgeRight).LineStyle = xlContinuous
                         .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    End With
               End If
          Next i
     End With
   
     'Afficher les journées vides
     Set Modèle = rg.Resize(11)
     For i = 1 To 374 Step 11
          If rg.Cells(i + 1, 1) = "" Then
               Modèle.Copy
               rg.Rows(i).Resize(374 - i + 1).PasteSpecial Paste:=xlPasteFormats
               Application.CutCopyMode = False
               Exit For
          End If
     Next i
     Application.Goto WSh.[A1]
     Application.ScreenUpdating = True
   
End Sub

frederio · 25 Juillet 2025

Bonsoir a tous,

Vendredi passe je partie en vacances en France sud

Ce aujourd’hui retour chez moi en belges
J’ai oublié déjà longtemps ne trouve pas site web pour winzip

Tu donne quel site web winzip

je envoyer fichier Excel taille ko

frederio · 27 Juillet 2025

Mon fichier Excel 3.34 Mo comment faire changer la taille ko envoyer de fichier Excel

AtTheOne · 27 Juillet 2025

Bonjour,
Si tu es sous windows peut-être avec un clic droit sur le nom du fichier et :

Mais, je ne pense pas que tu passes sous les 1 Mo avec un classeur de 3,34 Mo

Hallo,

Als je Windows gebruikt, klik dan met de rechtermuisknop op de bestandsnaam en: (afbeelding)
Maar ik denk niet dat je met een werkmap van 3,34 MB onder de 1 MB komt.

À bientôt
Tot snel

job75 · 27 Juillet 2025

Bonjour,

On peut utiliser un hébergeur de fichiers par exemple TransferNow.net

A+

frederio · 27 Juillet 2025

tu voir https://www.transfernow.net/dl/20250727mngbYudf

job75 · 27 Juillet 2025

Je ne vois pas les 2 macros que je vous ai données.

frederio · 27 Juillet 2025

tu es regarde voir

XL 2019 texte et bordure bouton vba

frederio

XLDnaute Impliqué

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

frederio

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Pièces jointes

frederio

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Pièces jointes

frederio

XLDnaute Impliqué

job75

XLDnaute Barbatruc

AtTheOne

XLDnaute Accro

Pièces jointes

frederio

XLDnaute Impliqué

frederio

XLDnaute Impliqué

AtTheOne

XLDnaute Accro

job75

XLDnaute Barbatruc

frederio

XLDnaute Impliqué

job75

XLDnaute Barbatruc

frederio

XLDnaute Impliqué

Discussions similaires

XL 2019 texte et bordure bouton vba

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency