Placer une bordure à gauche d'une colonne lorsque valeur trouvé

Résolu

bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention -
bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention - 26 avril 2016 à 16:40

Bonjour à tous,

J'ai créé une macro avec l'aide du forum pour effectuer, en autre, la mise en page d'un fichier Excel. Le nombre de lignes et de colonnes varient selon le fichier.

Je voudrais qu'à la première valeur "Sensor Temp" trouvé dans l'entête de mes colonnes, qu'il place une bordure xlmedium du côté gauche de colonne et ce jusqu'à la dernière ligne (derlig).

Voici mon code complet:

Option Explicit
Private Sub CommandButton1_Click()

Dim DerCol As Integer, DerLig As Integer, NoCol As Integer, Nbre As Byte, Cptr As Byte, Col As Integer, activesheets As Range
Dim i As Integer

Application.ScreenUpdating = False

Call mOuvrir.Choisir_fichier("en.dat")

UserForm1.Hide

With activesheets
    DerCol = Cells(2, Cells.Columns.Count).End(xlToLeft).Column
    DerLig = Range("A" & Rows.Count).End(xlUp).Row

    Columns("A").ColumnWidth = 13
    Columns("E").ColumnWidth = 10
    Columns("G:H").ColumnWidth = 10

    With Range(Cells(2, 1), Cells(DerLig, DerCol))
        .Borders.Weight = xlThin
        Cells.VerticalAlignment = xlVAlignCenter
        Cells.HorizontalAlignment = xlHAlignCenter
        .BorderAround ColorIndex:=1, Weight:=xlMedium
    End With
    
     Nbre = Application.CountIf(Rows(1), "Sensor*")
        If Nbre > 0 Then
            Col = Cells.Columns.Count
                For Cptr = 1 To Nbre
                    Col = Rows(1).Find("Sensor Temp", Cells(1, Col), xlValues).Column
                    With Cells(1, Col)
                        .Interior.ColorIndex = 37
                        .ColumnWidth = 15
                    End With
                Next
                For Cptr = 1 To Nbre
                Col = Rows(1).Find("Sensor Reading", Cells(1, Col), xlValues).Column
                    With Cells(1, Col)
                        .Interior.ColorIndex = 37
                        .ColumnWidth = 20
                    End With
                Next
        End If

    With Range(Cells(1, 1), Cells(1, DerCol))
        .RowHeight = 33
        .WrapText = True
        .Borders.Weight = xlThin
        .BorderAround ColorIndex:=1, Weight:=xlMedium
    End With
        
    Range(Cells(1, 2), Cells(DerLig, 4)).BorderAround ColorIndex:=1, Weight:=xlMedium
    Columns(9).Borders(xlEdgeLeft).Weight = xlMedium
    Columns(6).Borders(xlEdgeRight).Weight = xlMedium
    Range(Cells(1, 2), Cells(1, 4)).Interior.ColorIndex = 15
    
    For i = 2 To DerLig
        Range(Cells(i, 1), Cells(i, DerCol)).Interior.ColorIndex = 36
        i = i + 1
    Next i
  
End With

Application.ScreenUpdating = True
Application.Visible = True


End Sub

Merci pour votre aide!

A voir également:

Placer une bordure à gauche d'une colonne lorsque valeur trouvé
Déplacer une colonne excel - Guide
Trier une colonne excel - Guide
Windows 11 barre des taches a gauche - Guide
Placer des points sur une carte - Guide
Colonne word - Guide

2 réponses

Réponse 1 / 2

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

Bonjour,

La ligne

With activesheets

ne sert à rien :
- la plage (déclarée as Range) n'est pas définie
- elle n'est pas utilisée dans le reste du code

Ne serait-ce pas plutôt :

With ActiveSheet

mais dans ce cas, il faudrait l'utiliser dans le code ! Par exemple :

    DerCol = .Cells(2, .Cells.Columns.Count).End(xlToLeft).Column

bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention 1

Merci beaucoup Patrice33740!

Tu as totalement raison, elle m'a passé sous le nez celle-là!

J'ai apporté la correction.

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

En ajoutant les "." qui manquent sur toutes les lignes, pour faire référence à ActiveSheet, comme dans mon exemple, est-ce que ton code fonctionne ?

bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention 1 > Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention

J'ai seulement fait la modification pour la ligne DerCol et ça fonctionne!

Est-ce que j'aurais dû changer autre chose?

Mais je n'ai toujours pas trouvé comment mettre une bordure à gauche sur ma première colonne contenant le mot «Sensor Temp» dans son entête .

Réponse 2 / 2

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

Bonjour,

Tu devarit référencer tous les objets appartenant à ActiveSheet avec un point :

bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention 1

Comme ceci:

Option Explicit
Private Sub CommandButton1_Click()

Dim DerCol As Integer, DerLig As Integer, NoCol As Integer, Nbre As Byte, Cptr As Byte, Col As Integer, activesheets As Range
Dim i As Integer, fichier As String, nom As String, rep As String

Application.ScreenUpdating = False

Call mOuvrir.Choisir_fichier("en.dat")

UserForm1.Hide

With ActiveSheet
    DerCol = .Cells(2, .Cells.Columns.Count).End(xlToLeft).Column
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row

    .Columns("A").ColumnWidth = 13
    .Columns("E").ColumnWidth = 10
    .Columns("G:H").ColumnWidth = 10


    With .Range(Cells(2, 1), Cells(DerLig, DerCol))
        .Borders.Weight = xlThin
        Cells.VerticalAlignment = xlVAlignCenter
        Cells.HorizontalAlignment = xlHAlignCenter
        .BorderAround ColorIndex:=1, Weight:=xlMedium
    End With
    
     Nbre = Application.CountIf(Rows(1), "Sensor*")
        If Nbre > 0 Then
            Col = .Cells.Columns.Count
                For Cptr = 1 To Nbre
                    Col = .Rows(1).Find("Sensor Temp", Cells(1, Col), xlValues).Column
                    With .Cells(1, Col)
                        .Interior.ColorIndex = 37
                        .ColumnWidth = 15
                    End With
                Next
                For Cptr = 1 To Nbre
                Col = .Rows(1).Find("Sensor Reading", Cells(1, Col), xlValues).Column
                    With .Cells(1, Col)
                        .Interior.ColorIndex = 37
                        .ColumnWidth = 20
                    End With
                Next
        End If


    With .Range(Cells(1, 1), Cells(1, DerCol))
        .RowHeight = 33
        .WrapText = True
        .Borders.Weight = xlThin
        .BorderAround ColorIndex:=1, Weight:=xlMedium
    End With
    
    .Range(Cells(1, 2), Cells(DerLig, 4)).BorderAround ColorIndex:=1, Weight:=xlMedium
    .Range(Cells(1, 9), Cells(DerLig, 9)).Borders(xlEdgeLeft).Weight = xlMedium
    .Range(Cells(1, 6), Cells(DerLig, 6)).Borders(xlEdgeRight).Weight = xlMedium
    .Range(Cells(1, 2), Cells(1, 4)).Interior.ColorIndex = 15

    For i = 2 To DerLig
        .Range(Cells(i, 1), Cells(i, DerCol)).Interior.ColorIndex = 36
        i = i + 1
    Next i
  
End With

Application.Visible = True
fichier = UserForm2.TextBox1
            With ActiveWorkbook
                Application.DisplayAlerts = False
                nom = fichier & "_" & Format(Date, "yyyy-mm-dd") & "_" & ".xls"
                .SaveAs ActiveWorkbook.Path & "\" & nom, FileFormat:=xlNormal, CreateBackup:=False
                rep = MsgBox("Votre fichier est sauvegardée sous le nom : " & nom, vbOKCancel + vbInformation, "Copie sauvegarde classeur")
                If rep = vbCancel Then
                    Application.ThisWorkbook.Saved = True
                    ActiveWorkbook.Close
                    Exit Sub
                End If
                Application.DisplayAlerts = True
            End With

Application.ThisWorkbook.Saved = True
Application.ScreenUpdating = True
ActiveWorkbook.Close
Application.Quit


End Sub

bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention 1

Bon, j'ai trouvé un moyen de faire ce que je voulais! C'est probablement pas la meilleur solution, mais ça fonctionne. Voici mon code pour cette partie:

bre = Application.CountIf(Rows(1), "Sensor*")
        If Nbre > 0 Then
            Col = .Cells.Columns.Count
                For Cptr = 1 To Nbre
                    Col = .Rows(1).Find("Sensor Temp", Cells(1, Col), xlValues).Column
                    With .Cells(1, Col)
                        .Interior.ColorIndex = 37
                        .ColumnWidth = 15
                    End With
                        If Cptr = 1 Then 'Ici si le compteur égale 1, alors il place une bordure à gauche de ma colonne
                            .Range(Cells(1, Col), Cells(DerLig, Col)).Borders(xlEdgeLeft).Weight = xlMedium
                        End If
                Next
                For Cptr = 1 To Nbre
                Col = .Rows(1).Find("Sensor Reading", Cells(1, Col), xlValues).Column
                    With .Cells(1, Col)
                        .Interior.ColorIndex = 37
                        .ColumnWidth = 20
                    End With
                Next
        End If

Merci de commenter!

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780 > bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention

Re,

Sans le fichier, il est difficile de contrôler le code.

Pour les points, c'est exactement ça. Il en manque encore devant les cells :

  With .Range(Cells(2, 1), Cells(DerLig, DerCol))
    .Borders.Weight = xlThin
    .Cells.VerticalAlignment = xlVAlignCenter
    .Cells.HorizontalAlignment = xlHAlignCenter
    .BorderAround ColorIndex:=1, Weight:=xlMedium
  End With

Plutôt que :

For i = 2 To DerLig
  .Range(Cells(i, 1), Cells(i, DerCol)).Interior.ColorIndex = 36
  i = i + 1
Next i

Il est préférable d'écrire :

For i = 2 To DerLig Step 2
  .Range(Cells(i, 1), Cells(i, DerCol)).Interior.ColorIndex = 36
Next i

Et :

  .SaveAs ActiveWorkbook.Path & "\" & nom, FileFormat:=xlNormal, CreateBackup:=False

peut s'écrire :

  .SaveAs .Path & "\" & nom, FileFormat:=xlNormal, CreateBackup:=False

puisque le ActiveWorkbook est en With

bassmart Messages postés 281 Date d'inscription Statut Membre Dernière intervention 1 > Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention

Bonjour,

J'ai ajouté les points en avant de Cells, mais j'ai dû ajouter les deux même lignes dans mon code

With .Range(Cells(1, 1), Cells(1, DerCol))
        .RowHeight = 33
        .WrapText = True
        .Borders.Weight = xlThin
        .Cells.VerticalAlignment = xlVAlignCenter
        .Cells.HorizontalAlignment = xlHAlignCenter
        .BorderAround ColorIndex:=1, Weight:=xlMedium
    End With

pour que le texte soit centré aussi dans mes cellules d'entête.

Merci Beaucoup!

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

Bonjour,

Dans ce cas tu aurais aussi pu sortir les centrages du With .Range pour les appliquer à toute la feuille :

  .Cells.VerticalAlignment = xlVAlignCenter
  .Cells.HorizontalAlignment = xlHAlignCenter
  With .Range(Cells(2, 1), Cells(DerLig, DerCol))
    .Borders.Weight = xlThin
    .BorderAround ColorIndex:=1, Weight:=xlMedium
  End With
  With .Range(Cells(1, 1), Cells(1, DerCol))
    .RowHeight = 33
    .WrapText = True
    .Borders.Weight = xlThin
    .BorderAround ColorIndex:=1, Weight:=xlMedium
  End With

Edit : et simplifier :

  .Cells.VerticalAlignment = xlVAlignCenter
  .Cells.HorizontalAlignment = xlHAlignCenter
  With .Range(Cells(1, 1), Cells(DerLig, DerCol))
    .Rows(1).RowHeight = 33
    .Rows(1).WrapText = True
    .Borders.Weight = xlThin
    .BorderAround ColorIndex:=1, Weight:=xlMedium
  End With

Cdlt
Patrice

Discussions similaires

Tous les paragraphes sont considérés comme des titres

Votre réponse

Discussions similaires