Erreur d'execution '1004'

  • Initiateur de la discussion Initiateur de la discussion yde
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Y

yde

Guest
Bonjour,

J'ai réaliser un fichier avec macro qui pioche des données dans un tableau pour en faire une affiche (dans un autre onglet).
Or ma macro est assez capricieuse. sur certains PC, voir même sur le mien, de temps en temps j'ai cette erreur :
"Erreur d'éxecution '1004':
Impossible de définir la propriété LinsStyle de la classe Border."

Or le code est strictement respecté, car je n'ai fais que copier celui donné lorsque qu'on enregistre une macro.

Pouvez vous ml'aider s'il vous plait !!!
Un grand merci à tous !
 
Re : Erreur d'execution '1004'

avec toutes mes excuses !! voici le code qui plante :

Sub Formatage_Cellule(Nbre_Train, feuille)

Sheets(feuille).Select

Range(Cells(15, 2), Cells(14 + Nbre_Train, 5)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous 'ça plante ici !!😡
Selection.HorizontalAlignment = xlCenter
With Selection.Font
.Name = "Univers"
.Size = 12
End With

Range("B15").Select
 
Re : Erreur d'execution '1004'

RE

si tu as ton Nbre_train = 1 alors tu ne peux pas avoir de bordures interieures donc bug

donc

modifies ta ligne

Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous

par

if Nbre_Train > 1 then Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
 
Re : Erreur d'execution '1004'

RE

Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
c'est la mise en forme des bordures interieures horizontales

Quand tu as 1 ligne tu n'as pas de bordure interieur horizontale donc obligatoirement ça bug

Mais si tu ajoutes la condition que j'ai mis tu eviteras le bug
 
Re : Erreur d'execution '1004'

Bonjour,

Je rencontre un problème similaire mais au sein d'une subroutine agissant sur la selection courante.
Comment peut-on verifier qu'une ligne du type
With Selection.Borders(xlInsideHorizontal)
sera valide ?

merci d'avance
 
Re : Erreur d'execution '1004'

Sub Macro1test()
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Si la sélection courante est une ligne unique, ça plante (logique).
 
Re : Erreur d'execution '1004'

Bonjour à tous ça fait 2 jours que je cherche en vain sur tous les forums une aide, j'ai créé une macro qui prend des données d'une feuille pour les mettre dans une autre avec un tri et j'ai le message: mémoire insiffisante puis impossible d'établir la propriété size de la classe font.
Voici le code :
Sub OrgLeBlanc()


Range("E28").Select
Application.ScreenUpdating = False
ActiveSheet.Unprotect


Rows("16:18").Select
Range("C16").Activate
Selection.EntireRow.Hidden = False
'Le Blanc
' on prend le tableau listeleblanc définit auparavant, on y applique un
' filtre sur le ceer ou fonction et sur le secteur soit ici ceer et le blanc
' on copie les donnée pour les transférer a la colonne qui a pour entete cachée le
' nom prénom ainsi que le sigle grade

Range("ListeLeBlanc").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheets("Critères UT LeBLANC").Range("A1:B2"), CopyToRange:=Range("a17:b17"), _
Unique:=False
Range("A18").Select
Selection.CurrentRegion.Select

With Selection.Font
.Name = "Arial Narrow"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With

Application.ScreenUpdating = False
'Tournon
Range("ListeLeBlanc").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheets("Critères UT LeBLANC").Range("A5:B6"), CopyToRange:=Range("d17:e17"), _
Unique:=False
Range("d18").Select
Selection.CurrentRegion.Select

With Selection.Font
.Name = "Arial Narrow"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Application.ScreenUpdating = False

'St gautier
Range("ListeLeBlanc").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheets("Critères UT LeBLANC").Range("D5:E6"), CopyToRange:=Range("G17:H17"), _
Unique:=False
Range("g18").Select
Selection.CurrentRegion.Select

With Selection.Font
.Name = "Arial Narrow"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Application.ScreenUpdating = False
'Belabre
Range("ListeLeBlanc").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheets("Critères UT LeBLANC").Range("D1:E2"), CopyToRange:=Range("J17:K17"), _
Unique:=False
Range("J18").Select
Selection.CurrentRegion.Select

With Selection.Font
.Name = "Arial Narrow"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Application.ScreenUpdating = False

'Buzançais
Range("ListeLeBlanc").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheets("Critères UT LeBLANC").Range("D9:E10"), CopyToRange:=Range("M17:N17"), _
Unique:=False

Range("M18").Select
Selection.CurrentRegion.Select

With Selection.Font
.Name = "Arial Narrow"
.Size = 10 erreur ici
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Application.ScreenUpdating = False
Il y a encore du code apres mais je ne pense pas qu'il soit utile
Merci à ceux qui s'attarderont sur ce code^^
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
1
Affichages
830
L
Réponses
8
Affichages
1 K
O
Réponses
1
Affichages
972
T
  • Question Question
Réponses
4
Affichages
1 K
Thibault123
T
Réponses
4
Affichages
850
S
  • Question Question
Réponses
6
Affichages
2 K
StagiairePasPayé
S
G
Réponses
1
Affichages
2 K
G
Retour