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

Résolu/Fermé

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 21 avril 2016 à 18:46
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 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
Windows 11 barre des taches a gauche - Guide
Placer des points sur une carte - Guide
Figer une colonne excel - Guide
Colonne word - Guide

2 réponses

Réponse 1 / 2

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
21 avril 2016 à 21:52

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 jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
25 avril 2016 à 15:45

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 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
25 avril 2016 à 17:35

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 jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
25 avril 2016 à 18:37

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 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
25 avril 2016 à 19:12

Bonjour,

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

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
25 avril 2016 à 19:57

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 jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
25 avril 2016 à 20:27

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 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775 > bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023
25 avril 2016 à 21:10

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

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 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
Modifié par Patrice33740 le 26/04/2016 à 16:16

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

je veut créer des codes

Trouver un nom avec une adresse

liste de noms par ordre alphabétique

colonne A disparue tableur excel

[Excel] Vérifier existence cellules colonne A dans colonne C

Discussions similaires

Newsletters