Comment faire ?
Copier une feuille Excel sans son code VBA...
Le saviez-vous ?
Si Excel s'ouvre sans charger le classeur sur lequel vous venez de double-cliquer dans l'Explorateur Windows, vous pouvez rétablir le fonctionnement attendu en modifiant une simple option dans Excel...
Bienvenue à ...
Crouneur
Inscrit(e) le 08-09-2010 |
jc24
Inscrit(e) le 06-09-2010 |
Fave
Inscrit(e) le 06-09-2010 |
sitaleb
Inscrit(e) le 05-09-2010 |
paulh
Inscrit(e) le 03-09-2010 |
|
|
jogig
|
mDF MFCmultiples v5.1 - copier les bordures aussi |
|
|
Newbie XLpages
Inscrit(e):
29-07-2010
Groupe :
Utilisateurs enregistrés
Version(s) Excel:
2003
|
Posté le : 29-07-2010 21h06
Bonjour tout le monde,
J'utilise le code MFCmultiples v5.1 que j'ai trouvé sur ce site, mais il me semble que ce code ne fonctionne pas avec les bordures...
Est-ce qu'il y aurait un moyen pour que le formattage condionnel considère aussi les bordures (c'est surtout les 2 diagonales qui m'intéressent)?
Merci d'avance!
|
|
|
|
myDearFriend!
|
Re: mDF MFCmultiples v5.1 - copier les bordures aussi |
|
Webmestre
Inscrit(e):
18-05-2006
De Saône-et-Loire (71)
Groupe :
Webmestre
Version(s) Excel:
97, 2000, 2002, 2003, 2007
|
Posté le : 29-07-2010 22h30
Bonsoir jogig et bienvenue sur XLpages.com 
Curieusement, une des premières versions de cette macro incluait également la prise en compte des bordures. De mémoire, j'en avais supprimé la gestion sur demande d'un utilisateur à l'époque... comme quoi, chacun a ses préférences.
Pour rétablir la prise en compte des bordures, il te faut :
- d'une part, définir les bordures dans l'onglet MFC (c'est à dire inclure les valeurs, leur format cible ainsi que les bordures souhaitées).
- Puis, en te basant toujours sur le code proposé dans le fichier Exemple en Téléchargement, dans le code VBA de l'objet ThisWorkbook, tu dois remplacer la procédure Workbook_SheetChange (et seulement celle-ci), par :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim FCible As Range, RCible As Range, Cible As Range, Plage As Range, T As Range, _
Tplage As Range, PlageFC As Range
Dim Adr As String
Dim N As Boolean, P As Boolean, A As Boolean, VFC As Boolean
On Error Resume Next
Set PlageFC = Sh.Cells.SpecialCells(xlCellTypeAllFormatConditions)
If PlageFC Is Nothing Then Exit Sub
'Définition de la Plage cible
Set Plage = Target
Set Tplage = Plage.Dependents
Set Plage = Application.Union(Plage, Tplage)
On Error GoTo 0
Set Plage = Application.Intersect(Plage, PlageFC)
If Plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set Tplage = Nothing
For Each T In Plage
VFC = VerifFCond(T)
If VFC Then
If Tplage Is Nothing Then
Set Tplage = T
Else
Set Tplage = Union(Tplage, T)
End If
End If
Next T
'Traitement de la plage Cible
If Not Tplage Is Nothing Then
With ActiveWorkbook.Styles("Normal")
N = .IncludeNumber
P = .IncludeProtection
A = .IncludeAlignment
.IncludeNumber = False
.IncludeProtection = False
.IncludeAlignment = False
End With
For Each Cible In Tplage
Set FCible = FormatCible(Cible)
Set RCible = Nothing
On Error Resume Next
With Cible
Adr = Mid(.ID, 3)
Select Case Adr
Case "Cel"
Set RCible = Cible
Case "Lig"
Set RCible = Application.Intersect(.EntireRow, ActiveSheet.UsedRange)
Case Else
Adr = Replace(Adr, ";", ",")
If Val(Replace(Adr, "$", "")) > 0 Then
Set RCible = Application.Intersect(.EntireColumn, Range(Adr))
Else
Set RCible = Application.Intersect(.EntireRow, Range(Adr))
End If
End Select
End With
On Error GoTo 0
If Not RCible Is Nothing Then
With RCible
If FCible.Row = 65536 Then
'Format standard
.Style = "Normal"
Else
'Format MFC
With .Font
.Bold = FCible.Font.Bold
.Color = FCible.Font.Color
.Italic = FCible.Font.Italic
.Name = FCible.Font.Name
.Size = FCible.Font.Size
.Strikethrough = FCible.Font.Strikethrough
.Subscript = FCible.Font.Subscript
.Superscript = FCible.Font.Superscript
.Underline = FCible.Font.Underline
End With
With .Interior
.Color = FCible.Interior.Color
.Pattern = FCible.Interior.Pattern
.PatternColor = FCible.Interior.PatternColor
End With
With .Borders
.Color = FCible.Borders.Color
.LineStyle = FCible.Borders.LineStyle
.Weight = FCible.Borders.Weight
End With
End If
End With
End If
Next Cible
With ActiveWorkbook.Styles("Normal")
.IncludeNumber = N
.IncludeProtection = P
.IncludeAlignment = A
End With
End If
Application.ScreenUpdating = True
End Sub
Pour info, pour obtenir cette nouvelle procédure, j'ai supprimé toute notion de " .IncludeBorder" et j'ai ajouté les 5 lignes suivantes :
With .Borders
.Color = FCible.Borders.Color
.LineStyle = FCible.Borders.LineStyle
.Weight = FCible.Borders.Weight
End With
En espérant que ça puisse répondre à ton besoin.
Cordialement,
|
Didier_mDF  Le Webmaster La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
|
|
jogig
|
Re: mDF MFCmultiples v5.1 - copier les bordures aussi |
|
|
Newbie XLpages
Inscrit(e):
29-07-2010
Groupe :
Utilisateurs enregistrés
Version(s) Excel:
2003
|
Posté le : 29-07-2010 22h50
C'est exactement ce que je cherchais!
Merci pour ton aide et ta réponse rapide :)
|
|
|
|
jogig
|
Re: mDF MFCmultiples v5.1 - copier les bordures aussi |
|
|
Newbie XLpages
Inscrit(e):
29-07-2010
Groupe :
Utilisateurs enregistrés
Version(s) Excel:
2003
|
Posté le : 30-07-2010 15h25
Bonjour,
La solution que vous avez proposée fonctionne effectivement pour les bordures autour de la cellule, mais ça ne semble pas fonctionner pour les diagonales...est-ce qu'il y aurait moyen d'inclure les diagonales aussi?
Merci!
|
|
|
|
jogig
|
mDF MFCmultiples v5.1 - copier les bordures aussi (suite) |
|
|
Newbie XLpages
Inscrit(e):
29-07-2010
Groupe :
Utilisateurs enregistrés
Version(s) Excel:
2003
|
Posté le : 30-07-2010 16h43
Bonjour,
Une partie de ce problème avait été résolue dans une autre discussion, mais j'aimerais savoir s'il est possible d'inclure également les bordures diagonales dans le MFCmultiples v5.1?
La solution proposée par Didier permet de considérer les bordures autour de la cellule, mais la méthode ne semble pas fonctionner pour les bordures diagonales.
Voici le code proprosé par Didier pour inclure les bordures autour de la cellule:
With .Borders
.Color = FCible.Borders.Color
.LineStyle = FCible.Borders.LineStyle
.Weight = FCible.Borders.Weight
End With
Comment faire pour inclure les diagonales aussi?
Merci!
|
|
|
|
myDearFriend!
|
Re: mDF MFCmultiples v5.1 - copier les bordures aussi (suite) |
|
Webmestre
Inscrit(e):
18-05-2006
De Saône-et-Loire (71)
Groupe :
Webmestre
Version(s) Excel:
97, 2000, 2002, 2003, 2007
|
Posté le : 30-07-2010 21h49
Bonsoir jogig, le Forum,
Tout d'abord, j'ai fusionné le présent sujet avec le précédent (que je réactive) puisqu'il s'agit toujours du même problème...
Efffectivement, je m'aperçois que tu parlais des diagonales dans ton premier post, je n'avais pas fait attention.
Voici donc un moyen de contourner ce problème (même punition : procédure Workbook_SheetChange à remplacer) :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim FCible As Range, RCible As Range, Cible As Range, Plage As Range, T As Range, _
Tplage As Range, PlageFC As Range
Dim Adr As String
Dim B As Byte
Dim N As Boolean, P As Boolean, A As Boolean, VFC As Boolean
On Error Resume Next
Set PlageFC = Sh.Cells.SpecialCells(xlCellTypeAllFormatConditions)
If PlageFC Is Nothing Then Exit Sub
'Définition de la Plage cible
Set Plage = Target
Set Tplage = Plage.Dependents
Set Plage = Application.Union(Plage, Tplage)
On Error GoTo 0
Set Plage = Application.Intersect(Plage, PlageFC)
If Plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set Tplage = Nothing
For Each T In Plage
VFC = VerifFCond(T)
If VFC Then
If Tplage Is Nothing Then
Set Tplage = T
Else
Set Tplage = Union(Tplage, T)
End If
End If
Next T
'Traitement de la plage Cible
If Not Tplage Is Nothing Then
With ActiveWorkbook.Styles("Normal")
N = .IncludeNumber
P = .IncludeProtection
A = .IncludeAlignment
.IncludeNumber = False
.IncludeProtection = False
.IncludeAlignment = False
End With
For Each Cible In Tplage
Set FCible = FormatCible(Cible)
Set RCible = Nothing
On Error Resume Next
With Cible
Adr = Mid(.ID, 3)
Select Case Adr
Case "Cel"
Set RCible = Cible
Case "Lig"
Set RCible = Application.Intersect(.EntireRow, ActiveSheet.UsedRange)
Case Else
Adr = Replace(Adr, ";", ",")
If Val(Replace(Adr, "$", "")) > 0 Then
Set RCible = Application.Intersect(.EntireColumn, Range(Adr))
Else
Set RCible = Application.Intersect(.EntireRow, Range(Adr))
End If
End Select
End With
On Error GoTo 0
If Not RCible Is Nothing Then
With RCible
If FCible.Row = 65536 Then
'Format standard
.Style = "Normal"
Else
'Format MFC
With .Font
.Bold = FCible.Font.Bold
.Color = FCible.Font.Color
.Italic = FCible.Font.Italic
.Name = FCible.Font.Name
.Size = FCible.Font.Size
.Strikethrough = FCible.Font.Strikethrough
.Subscript = FCible.Font.Subscript
.Superscript = FCible.Font.Superscript
.Underline = FCible.Font.Underline
End With
With .Interior
.Color = FCible.Interior.Color
.Pattern = FCible.Interior.Pattern
.PatternColor = FCible.Interior.PatternColor
End With
With .Borders
.Color = FCible.Borders.Color
.LineStyle = FCible.Borders.LineStyle
.Weight = FCible.Borders.Weight
For B = 5 To 6
.Item(B).Color = FCible.Borders(B).Color
.Item(B).LineStyle = FCible.Borders(B).LineStyle
.Item(B).Weight = FCible.Borders(B).Weight
Next B
End With
End If
End With
End If
Next Cible
With ActiveWorkbook.Styles("Normal")
.IncludeNumber = N
.IncludeProtection = P
.IncludeAlignment = A
End With
End If
Application.ScreenUpdating = True
End Sub
Cette fois, j'ai ajouté les lignes suivantes :
'
'
Dim B As Byte
'
'
'
'
For B = 5 To 6
.Item(B).Color = FCible.Borders(B).Color
.Item(B).LineStyle = FCible.Borders(B).LineStyle
.Item(B).Weight = FCible.Borders(B).Weight
Next B
'
'
J'ai, bien sûr aussi dans l'idée que cette fois, le code mériterait d'être révisé en profondeur pour optimiser l'ensemble, mais je n'ai malheureusement pas le temps de me pencher là dessus en ce moment. Désolé.
En espérant que ça puisse te dépanner quand même...
Cordialement
|
Didier_mDF Le Webmaster La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
|
|
jogig
|
Re: mDF MFCmultiples v5.1 - copier les bordures aussi (suite) |
|
|
Newbie XLpages
Inscrit(e):
29-07-2010
Groupe :
Utilisateurs enregistrés
Version(s) Excel:
2003
|
Posté le : 31-07-2010 13h48
Cette fois ça fonctionne parfaitement!
Il me met des bordures diagonales noires par défaut même si je n'en avais pas mis dans les cellules "références" de la feuille MFC, mais je contourne le problème en mettant des diagonales de la même couleur que le fond de la cellule lorsque je ne désire pas avoir de diagonale.
Merci encore une fois! :)
|
|
|
Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous pouvez voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.
|
Transférer
![Open in new window](javascript:CaricaFoto("/uploads/Image/mDF.gif");)
