Astuce du jour: Palette de couleur sur le click droit

[MJ13]

Astuce du jour: Copier Coller Valeur Format...

Bonjour à tous

Voici le plan des différentes astuces présentes dans cette discussion (Mise à Jour le 21 03 2014):

Encadre Tableau

Mise en page feuille

Redimensionnement d'images

Capture Ecran

Encadrement tableau

Tri Tableau

Installer sur Win8 64 bits programmes anciens

Lancer nouvelle instance d'Excel

Astuces pour le forum

Supprimer les lignes en trop

Recherche Rapide Google

Tri Ascendant Descendant

Range Dossier suivant extension des fichiers V1 et V2


Résolution Ecran


Palette de couleur sur le click droit

Programmer le Bouton Marche/Arrêt

Résoudre le problème des Litviews

Copier Coller valeur format...


Quand , on programme en VBA, avec l'enregistreur de macros, on a souvent des lignes de codes superflues .

En essayant de trouver un moyen simple pour encadrer un tableau de toutes les cellules on peut écrire:

Code VBA:
Selection.Borders.LineStyle = xlContinuous




Au lieu de:


Code VBA:
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With




Je voulais le partager avec vous pour une fois que je trouve une astuce intéressante .

 

[Modeste geedee]

Re : Astuce du jour: Encadrement tableau VBA

Bonsour®
une petite macro à associer à un bouton permettant de réaliser rapidement des pseudos "userform-3D"

ex : nb : toujours commencer par le plage la plus étendue

Code vba:
Sub Embossage1()
' Macro by modeste geedee XLD 12/04/2013
Dim reponse As Variant
reponse = InputBox("Effet d'éclairage en haut à gauche" & Chr(10) & "Creux=1,Bosse=0", "Effet 3D Embossage", 0)
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = IIf(reponse = True, vbBlack, vbWhite)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = IIf(reponse = True, vbBlack, vbWhite)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = IIf(reponse = True, vbWhite, vbBlack)
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = IIf(reponse = True, vbWhite, vbBlack)
.Weight = xlThick
End With
Selection.Interior.Color = RGB(192, 192, 192)
End Sub

 

[MJ13]

Re : Astuce du jour: Tri Tableau

Bonjour à tous

Les tris, c'est souvent galère entre versions .

Voici une macro pour trier une base de données (facilement adaptable) commençant en ligne 1 sur 6 colonnes. Adapté à partir des versions XL2007.

Pour l'utiliser, positionnez vous sur la première ligne sur la colonne à trier et lancer la macro. Pour faire un tri descendant, il suffit de changer xlAscending par xlDescending.

Sub Tri_Ligne1_Ascendant()
'Tri Ascendant
'MsgBox Rows.Count
'[D1].Select
Derl = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
'If Derl <= 4 Then Exit Sub
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range(ActiveCell.Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
        .SetRange Range("A1:F" & Derl)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

 

[sixair]

Re : Astuce du jour: Tri Tableau

Bonjour,
merci pour le partage.

Parmi mes macros dans le classeur perso, la plus simple et la plus employée...
j'ai affecté la séquence Ctrl+W pour le collage/spécial/valeur.

Sub Coller_valeur()
' Touche de raccourci du clavier: Ctrl+w
On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
End Sub

Cdlt
sixair

 

[MJ13]

Re : Astuce du jour: Encadrement tableau VBA

Bonjour à tous

Merci Sixair. je l'engrange dans mon Pense-bête .

Sinon, en reprenant le tri précédent, voici un code pour trier Ascendant et descendant successivement avec la même macro (on peut relancer la dernière macro avec la touche F4) .

Public ordre
Sub Tri_Ligne1_Ascendant_Descendant()
'Tri Ascendant_Descendant
'MsgBox Rows.Count
'[D1].Select
Derl = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
'If Derl <= 4 Then Exit Sub
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
If ordre = 0 Then ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range(ActiveCell.Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers: ordre = ordre + 1: GoTo suite
If ordre = 1 Then ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range(ActiveCell.Address) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers: ordre = ordre + 1: GoTo suite
suite:
    With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
        .SetRange Range("A1:F" & Derl)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
If ordre = 2 Then ordre = 0
End Sub

 

[Staple1600]

Re : Astuce du jour: Encadrement tableau VBA

Bonsoir à tous

Pour collage valeurs seules, on peut aussi faire ceci:

Sub CollerValeurs()
With Selection
    .Value = .Value
End With
End Sub

 

[Si...]

Re : Astuce du jour: Encadrement tableau VBA

salut

...
Sinon, en reprenant le tri précédent, voici un code pour trier Ascendant et descendant successivement avec la même macro...

et ainSi... ?

Dim n As Byte
Sub Tri()
  n = IIf(n = 1, 2, 1)
  Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Sort [A1], n
End Sub

 

[MJ13]

Re : Astuce du jour: Tri talbeau

Bonjour à tous

Merci JM et Si pour votre collaboration .

Du coup, j'ai revu plus simple le tri comme ceci (cette macro est importante dans certains cas):

Public ordre
Sub Tri_Ligne1_Ascendant_DescendantV2()
'Tri Ascendant_Descendant

Derl = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
    
If ordre = 0 Then ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range(ActiveCell.Address) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers Else ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range(ActiveCell.Address) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
        
ordre = ordre + 1: If ordre = 2 Then ordre = 0

    With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
        .SetRange Range("A1:F" & Derl)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[MJ13]

Re : Astuce du jour: Problème compatibilité Windows 8 64 bits

Bonjour à tous

Si vous avec Windows 8 en Version 64 bits et que des programmes ne s'installent pas correctement et provoque un bug lors de l'installation, vous pouvez tester cette procédure dans le PDF joint.

Faire un click droit sur le fichier .exe à installer et suivez les copies d'écran.

 

[MJ13]

Re : Astuce du jour: [XL 2013] Ouvrir 2 instances d'Excel

Bonjour à tous

Un des problèmes d'Excel 2013 est la gestion des instances qui n'est plus aussi smple qu'avant . Maintenant, si vous ouvrez 2 fois Excel, il seront dans la même instance. A force de chercher, j'ai trouvé une solution sur le net:

Il faut le lancer avec les touches Windows + r (correspondant à la commande Exécuter) et taper:

excel /x

Vous pouvez ensuite le vérifier en tapant Ctrl+Alt+Suppr et choisir Ouvrir le gestionnaire des tâches pour vérifier que vous avez bien 2 instances d'excel ouvertes.

 

[MJ13]

Re : Astuce du jour: résouder les problème de code ancien avec HightLight

Bonjour à tous.

Certains trouvent plus beau (comme Jean-Marie ), de mettre highlight dans le code pour le rendre plus attrayant au niveau coloration .

Mais récupérer d'anciens posts peux s'avérer problèmatique (voir fichier joint).

Donc, voici une astuce dans le fichier.

 

[DoubleZero]

Re : Astuce du jour: résouder les problème de code ancien avec HightLight

Bonjour, Michel , le Fil, le Forum,

... récupérer d'anciens posts peux s'avérer problèmatique (voir fichier joint). Donc, voici une astuce dans le fichier.

... la même astuce, par macro :

Option Explicit
Sub Charabia_sélectionné_traduire()
    Selection.Replace What:="
[*]", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

A bientôt

 

[Staple1600]

Re : Astuce du jour: Encadrement tableau VBA

Bonjour à tous,_____________ (MJ13, 00 )

Certains trouvent plus beau (comme Jean-Marie ), de mettre highlight dans le code pour le rendre plus attrayant au niveau coloration

Je n'irai pas jusqu'à dire qu'il y a un beau à voir chez VBA __________________(Oups! j'ai contrepété sans le vouloir )
Mais c'est plus facile à lire quand le code est formaté, non ?
En plus cela accroît l'addiction à l'usage intensif de VBE, car même sur XLD, on a ainsi, avec l'emploi es balises BBCODE idoines, l'impression d'être toujours chez Excel.

Et là, oui, je dirai comme a presque dit le grand Richard B. :

"Putain, c'est beau Excel la nuit!
Putain, c'est mieux un post xldien
Quand O joie, dedans nos yeux
tombent sur les balises à format"

​

EDITION: Bonjour chris

 

[chris]

Re : Astuce du jour: Encadrement tableau VBA

Bonjour à tous

J'avais vu les tout premiers posts de ce fil mais avait loupé la suite .
Merci de ces astuces .

Par rapport au #5, depuis la version 2007, l'option pour ne pas appliquer le zoom aux en-tête/pieds existe :

    With ActiveSheet.PageSetup
        .ScaleWithDocHeaderFooter = False
    End With

de même on peut aligner les marges des en-tête/pieds sur les marges du document (et non à 2 cm symétriquement de façon immuable)

    With ActiveSheet.PageSetup
        .AlignMarginsHeaderFooter =True
    End With

Comme dans Word on peut également avoir des en-tête/pieds différents sur la 1ère page.

   With ActiveSheet.PageSetup
         .DifferentFirstPageHeaderFooter = True
    End With

et paramétrer le contenu

   With ActiveSheet.PageSetup
        .FirstPage.LeftHeader.Text = "page 1 gauche"
        .FirstPage.CenterHeader.Text = "page 1 centre"
        .FirstPage.RightHeader.Text = "page 1 droite"
        .FirstPage.LeftFooter.Text = "page 1 gauche"
        .FirstPage.CenterFooter.Text = "page 1 centre"
        .FirstPage.RightFooter.Text = "page 1 droite"
    End With

et/ou différents sur les pages paires et impaires

   With ActiveSheet.PageSetup
       .OddAndEvenPagesHeaderFooter = True
    End With

et paramétrer le contenu des pages paires, les autres en-tête pied restant affectés aux pages impaires

   With ActiveSheet.PageSetup
        .EvenPage.LeftHeader.Text = "En-tête pair gauche"
        .EvenPage.CenterHeader.Text = "En-tête pair centre"
        .EvenPage.RightHeader.Text = "En-tête pair droite"
        .EvenPage.LeftFooter.Text = "Pied pair gauche"
        .EvenPage.CenterFooter.Text = "Pied pair centre"
        .EvenPage.RightFooter.Text = "Pied pair droit"
    End With

Enfin, toujours depuis la version 2007, on peut mettre de la couleur dans les textes d' En-tête/pieds.

 

[MJ13]

Re : Astuce du jour: Messages XLD ordre inverse

Bonjour à tous

Merci 00 et Chris pouir votre participation pour trouver de nouvelles astuces et les faire partager .

Jean-Marie: l'autre jour, j'ai bien essayé de mettre Higlight comme tu le préconises mais je n'y suis jamais arrivé . Par contre quand je vois d'anciens codes avec des codes bizarres, je peux appliquer ma solution .

Sinon une petite astuce pour votre forum préféré: dans les options du site, vous pouvez afficher l'ordre des messages du plus ancien au plus récent. Personnellement, je met les plus récents en premier. Ainsi, je n'ai pas besoin de tout parcourir pour avoir les derniers messages. Il faut aller dans Tableau de bord puis choisir Options générales du forum (voir image).

 

[Modeste geedee]

Re : Astuce du jour: Messages XLD ordre inverse

Bonsour®

Bonjour à tous


Jean-Marie: l'autre jour, j'ai bien essayé de mettre Higlight comme tu le préconises mais je n'y suis jamais arrivé . Par contre quand je vois d'anciens codes avec des codes bizarres, je peux appliquer ma solution .

mes élucubrations m'ont conduit à tester l'usage de la balise

 avec plusieurs parametres différents

voir exemples ci-dessous
et bien qu'utilisant EXCEL et VBA j'aurai une préférence pour l'argument [CODE=VB]
ne pas oublier de terminer par la balise [/CODE

[CODE=Pascal]Option Explicit

Private Sub Worksheet_Activate()
Dim cell As Range
For Each cell In Range("a7:az7")
If cell.Value < [Lg_Ht] Then
cell.ColumnWidth = cell.Offset(-1, 0).Value / 20
cell.EntireColumn.Hidden = False
Else
cell.EntireColumn.Hidden = True
End If
Next
End Sub

Option Explicit

Private Sub Worksheet_Activate()
Dim cell As Range
For Each cell In Range("a7:az7")
If cell.Value < [Lg_Ht] Then
cell.ColumnWidth = cell.Offset(-1, 0).Value / 20
cell.EntireColumn.Hidden = False
Else
cell.EntireColumn.Hidden = True
End If
Next
End Sub

Option Explicit

Private Sub Worksheet_Activate()
Dim cell As Range
For Each cell In Range("a7:az7")
If cell.Value < [Lg_Ht] Then
cell.ColumnWidth = cell.Offset(-1, 0).Value / 20
cell.EntireColumn.Hidden = False
Else
cell.EntireColumn.Hidden = True
End If
Next
End Sub

Option Explicit

Private Sub Worksheet_Activate()
Dim cell As Range
For Each cell In Range("a7:az7")
If cell.Value < [Lg_Ht] Then
cell.ColumnWidth = cell.Offset(-1, 0).Value / 20
cell.EntireColumn.Hidden = False
Else
cell.EntireColumn.Hidden = True
End If
Next
End Sub

Option Explicit

Private Sub Worksheet_Activate()
Dim cell As Range
For Each cell In Range("a7:az7")
If cell.Value < [Lg_Ht] Then
cell.ColumnWidth = cell.Offset(-1, 0).Value / 20
cell.EntireColumn.Hidden = False
Else
cell.EntireColumn.Hidden = True
End If
Next
End Sub

Option Explicit

Private Sub Worksheet_Activate()
Dim cell As Range
For Each cell In Range("a7:az7")
If cell.Value < [Lg_Ht] Then
cell.ColumnWidth = cell.Offset(-1, 0).Value / 20
cell.EntireColumn.Hidden = False
Else
cell.EntireColumn.Hidden = True
End If
Next
End Sub