Formule pour colorier une ligne dans une macro déjà existante
Fermé
bamboougo
Messages postés
13
Date d'inscription
lundi 4 mars 2013
Statut
Membre
Dernière intervention
5 avril 2013
-
4 mars 2013 à 10:51
bamboougo Messages postés 13 Date d'inscription lundi 4 mars 2013 Statut Membre Dernière intervention 5 avril 2013 - 6 mars 2013 à 12:03
bamboougo Messages postés 13 Date d'inscription lundi 4 mars 2013 Statut Membre Dernière intervention 5 avril 2013 - 6 mars 2013 à 12:03
A voir également:
- Formule pour colorier une ligne dans une macro déjà existante
- Formule excel pour additionner plusieurs cellules - Guide
- Formule si et - Guide
- Aller à la ligne dans une cellule excel - Guide
- Formule pour calculer une moyenne sur excel - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
5 réponses
via55
Messages postés
14501
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
28 novembre 2024
2 735
4 mars 2013 à 12:24
4 mars 2013 à 12:24
Bonjour
S'agit il bien d'une macro(en VBA) ou d'une mise en forme conditionnelle
Quelle version d'Exel est utilisée?
Le mieux est de poster si possible un exemple du fichier allégé et anonymé sur cjoint.com et d'indiquer le lien fourni dans un prochain message
Cdlmnt
S'agit il bien d'une macro(en VBA) ou d'une mise en forme conditionnelle
Quelle version d'Exel est utilisée?
Le mieux est de poster si possible un exemple du fichier allégé et anonymé sur cjoint.com et d'indiquer le lien fourni dans un prochain message
Cdlmnt
bamboougo
Messages postés
13
Date d'inscription
lundi 4 mars 2013
Statut
Membre
Dernière intervention
5 avril 2013
4 mars 2013 à 12:37
4 mars 2013 à 12:37
Il s'agit de la vesion 2003, il s'agit bien d'une macro VBA.
Je ne peux allégé le fichier et le publier (peu de connaissances VBA) et peur de modifier la macro actuelle.
J'ai déjà voulu faire des modifs, mais impossible de l'enregistrer... Je ne connaît pas la manip pour modifier et enregistrer une macro existante.
PS : Les fichiers excel sont extraits d'une application.
Je ne peux allégé le fichier et le publier (peu de connaissances VBA) et peur de modifier la macro actuelle.
J'ai déjà voulu faire des modifs, mais impossible de l'enregistrer... Je ne connaît pas la manip pour modifier et enregistrer une macro existante.
PS : Les fichiers excel sont extraits d'une application.
via55
Messages postés
14501
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
28 novembre 2024
2 735
4 mars 2013 à 13:52
4 mars 2013 à 13:52
Sans la macro difficile à dire !
ALT F8 ou Outils Macros pour faire apparaitre la liste des macros disponibles dans le classeur
Selectionner la macro que tu veux modifier puis Pas à pas détaillé pour voir le code
Faire un copier du code et le coller ici dans un prochain message, on y verra plus clair !
ALT F8 ou Outils Macros pour faire apparaitre la liste des macros disponibles dans le classeur
Selectionner la macro que tu veux modifier puis Pas à pas détaillé pour voir le code
Faire un copier du code et le coller ici dans un prochain message, on y verra plus clair !
bamboougo
Messages postés
13
Date d'inscription
lundi 4 mars 2013
Statut
Membre
Dernière intervention
5 avril 2013
4 mars 2013 à 14:13
4 mars 2013 à 14:13
Voici le code :
<ital>Sub PlanningEncres()
'
' PlanningEncres Macro
' Macro enregistrée le 30/11/2012 par planning.ussel
'
If LCase(Left(ActiveWorkbook.Name, 19)) <> "planning impression" Then
tto = MsgBox("Cette macro ne peut être utilisée avec ce classeur.", vbCritical, "Erreur")
Else
For Each Feuil In Sheets
Feuil.Select
' For Each s In ThisWorkbook.Worksheets
Selection.UnMerge
Range("A1").Select
ActiveCell.FormulaR1C1 = "PLANNING IMPRESSION"
Range("A1").Select
Columns("E:F").Hidden = True
Columns("J:J").Hidden = True
Columns("M:Q").Hidden = True
Columns("S:S").Hidden = True
Columns("U:X").Hidden = True
Columns("AE:AF").Hidden = True
Columns("AH:AK").Hidden = True
'reduction de la taille des colonnes
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Columns("A:A").Select
With Selection.Font
.Name = "Arial"
.Size = 22
End With
Columns("B:B").ColumnWidth = 20.43
Columns("A:A").ColumnWidth = 15.5
Columns("C:C").ColumnWidth = 38
Columns("R:R").Select
Columns("H:H").ColumnWidth = 12.43
Columns("I:I").ColumnWidth = 55
Columns("T:T").ColumnWidth = 16.71
Columns("K:K").ColumnWidth = 16.71
Columns("Y:AD").ColumnWidth = 21.5
Columns("AG:AG").ColumnWidth = 14.5
Columns("AL:AL").ColumnWidth = 14.5
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("HEIDELBERG 740").Activate
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Selection.Copy
Columns("R:R").ColumnWidth = 35.86
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$AK$60"
Next
End If
'Mise en page avant impression
Sheets("HEIDELBERG 740").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AL$60"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "COLORIMETRIE/PREPRESSE"
.CenterFooter = "USSEL - HEIDELBERG"
.RightFooter = "planning.ussel@chesapeakecorp.com"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(1.5)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
Sheets("KBA 105").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AL$60"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "COLORIMETRIE / PREPRESSE&N"
.CenterFooter = "USSEL - KBA 1"
.RightFooter = "planning.ussel@chesapeakecorp.com"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(1.5)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Sheets("KBA II 105").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AL$60"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "COLORIMETRIE/PREPRESSE"
.CenterFooter = "USSEL - KBA 2"
.RightFooter = "planning.ussel@chesapeakecorp.com"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(1.5)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
' Efface "Field Boxmore"
Range("A4:B4").Select
Selection.ClearContents
Sheets("HEIDELBERG 740").Select
Range("A4:B4").Select
Selection.ClearContents
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("HEIDELBERG 740").Activate
Rows("7:269").Select
With Selection.Font
.Name = "Arial"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Columns("T:T").Select
Selection.ColumnWidth = 33
Columns("Y:AD").Select
Selection.ColumnWidth = 34.86
Columns("G:G").Select
Selection.ColumnWidth = 25.57
Columns("D:D").Select
Selection.ColumnWidth = 27
Columns("B:B").ColumnWidth = 26.29
Columns("A:A").ColumnWidth = 21
Columns("H:H").Select
Selection.ColumnWidth = 16.43
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("HEIDELBERG 740").Activate
Range("C28").Select
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("KBA II 105").Activate
Range("C33").Select
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("KBA 105").Activate
Range("C34").Select
End Sub</ital>
<ital>Sub PlanningEncres()
'
' PlanningEncres Macro
' Macro enregistrée le 30/11/2012 par planning.ussel
'
If LCase(Left(ActiveWorkbook.Name, 19)) <> "planning impression" Then
tto = MsgBox("Cette macro ne peut être utilisée avec ce classeur.", vbCritical, "Erreur")
Else
For Each Feuil In Sheets
Feuil.Select
' For Each s In ThisWorkbook.Worksheets
Selection.UnMerge
Range("A1").Select
ActiveCell.FormulaR1C1 = "PLANNING IMPRESSION"
Range("A1").Select
Columns("E:F").Hidden = True
Columns("J:J").Hidden = True
Columns("M:Q").Hidden = True
Columns("S:S").Hidden = True
Columns("U:X").Hidden = True
Columns("AE:AF").Hidden = True
Columns("AH:AK").Hidden = True
'reduction de la taille des colonnes
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Columns("A:A").Select
With Selection.Font
.Name = "Arial"
.Size = 22
End With
Columns("B:B").ColumnWidth = 20.43
Columns("A:A").ColumnWidth = 15.5
Columns("C:C").ColumnWidth = 38
Columns("R:R").Select
Columns("H:H").ColumnWidth = 12.43
Columns("I:I").ColumnWidth = 55
Columns("T:T").ColumnWidth = 16.71
Columns("K:K").ColumnWidth = 16.71
Columns("Y:AD").ColumnWidth = 21.5
Columns("AG:AG").ColumnWidth = 14.5
Columns("AL:AL").ColumnWidth = 14.5
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("HEIDELBERG 740").Activate
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Selection.Copy
Columns("R:R").ColumnWidth = 35.86
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$AK$60"
Next
End If
'Mise en page avant impression
Sheets("HEIDELBERG 740").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AL$60"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "COLORIMETRIE/PREPRESSE"
.CenterFooter = "USSEL - HEIDELBERG"
.RightFooter = "planning.ussel@chesapeakecorp.com"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(1.5)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
Sheets("KBA 105").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AL$60"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "COLORIMETRIE / PREPRESSE&N"
.CenterFooter = "USSEL - KBA 1"
.RightFooter = "planning.ussel@chesapeakecorp.com"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(1.5)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Sheets("KBA II 105").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$AL$60"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "COLORIMETRIE/PREPRESSE"
.CenterFooter = "USSEL - KBA 2"
.RightFooter = "planning.ussel@chesapeakecorp.com"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(1.5)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
.PrintErrors = xlPrintErrorsDisplayed
End With
' Efface "Field Boxmore"
Range("A4:B4").Select
Selection.ClearContents
Sheets("HEIDELBERG 740").Select
Range("A4:B4").Select
Selection.ClearContents
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("HEIDELBERG 740").Activate
Rows("7:269").Select
With Selection.Font
.Name = "Arial"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Columns("T:T").Select
Selection.ColumnWidth = 33
Columns("Y:AD").Select
Selection.ColumnWidth = 34.86
Columns("G:G").Select
Selection.ColumnWidth = 25.57
Columns("D:D").Select
Selection.ColumnWidth = 27
Columns("B:B").ColumnWidth = 26.29
Columns("A:A").ColumnWidth = 21
Columns("H:H").Select
Selection.ColumnWidth = 16.43
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("HEIDELBERG 740").Activate
Range("C28").Select
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("KBA II 105").Activate
Range("C33").Select
Sheets(Array("HEIDELBERG 740", "KBA II 105", "KBA 105")).Select
Sheets("KBA 105").Activate
Range("C34").Select
End Sub</ital>
via55
Messages postés
14501
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
28 novembre 2024
2 735
5 mars 2013 à 11:59
5 mars 2013 à 11:59
Possible que le reseau empeche
Mais là ça dépasse mes compétences !
Repose la question sur le forum en changeant le titre et en indiquant quelque chose du style probleme pour enregistrer modifications fichier sur reseau
Tu trouveras bien quelqu'un qui connait le probleme et peut etre une solution
Bonne suite
Mais là ça dépasse mes compétences !
Repose la question sur le forum en changeant le titre et en indiquant quelque chose du style probleme pour enregistrer modifications fichier sur reseau
Tu trouveras bien quelqu'un qui connait le probleme et peut etre une solution
Bonne suite
bamboougo
Messages postés
13
Date d'inscription
lundi 4 mars 2013
Statut
Membre
Dernière intervention
5 avril 2013
6 mars 2013 à 12:03
6 mars 2013 à 12:03
Merci
bamboougo
Messages postés
13
Date d'inscription
lundi 4 mars 2013
Statut
Membre
Dernière intervention
5 avril 2013
4 mars 2013 à 16:36
4 mars 2013 à 16:36
Si je modifie ce code (largeur de colonne), Ou faut il enregistrer le fichier ?
Car malgré l'enregistrement à la fermeture, il faut refaire cette mise en page systémétiquement.
Merci pour votre aide.
Car malgré l'enregistrement à la fermeture, il faut refaire cette mise en page systémétiquement.
Merci pour votre aide.
via55
Messages postés
14501
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
28 novembre 2024
2 735
4 mars 2013 à 19:38
4 mars 2013 à 19:38
Si tu fais une modification dans le code en principe l'enregistrement se fait automatiquement à la fermeture du classeur SAUF si une ligne de code a été mise pour empecher l'enregistrement style :
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
End Sub
qui annule les demandes d'enregistrement
ou
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ThisWorkbook.Saved = True
End Sub
qui Informe Excel que le fichier a déjà été enregistré et évite donc une demande d'enregistrement à la fermeture
Il faut aller voir dans l'editeur (ALT F11) et dans This Workbook
Quant à la coloration des lignes il vaut mieux la faire par une autre macro ou plus simplement par une mise en forme conditionnelle
ex si on veut colorer une ligne de A à M si nombre 18 en colonne B
sélectionner toute la plage (allant par ex de A2 à M100)
Mise en forme conditionnelle
Nouvelle règle
Appliquer une formule .....
et entrer la formule =$B2=18 et choisir la couleur dans Format
où A2 est la 1ere cellule de la plage où trouver le nombre déclencheur
Bien respecter le$ avant la reference de colonne
Pour plusieurs conditions la formule sera =OU($B2=18;$B2=20;$B2=40)
Cdlmnt
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
End Sub
qui annule les demandes d'enregistrement
ou
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ThisWorkbook.Saved = True
End Sub
qui Informe Excel que le fichier a déjà été enregistré et évite donc une demande d'enregistrement à la fermeture
Il faut aller voir dans l'editeur (ALT F11) et dans This Workbook
Quant à la coloration des lignes il vaut mieux la faire par une autre macro ou plus simplement par une mise en forme conditionnelle
ex si on veut colorer une ligne de A à M si nombre 18 en colonne B
sélectionner toute la plage (allant par ex de A2 à M100)
Mise en forme conditionnelle
Nouvelle règle
Appliquer une formule .....
et entrer la formule =$B2=18 et choisir la couleur dans Format
où A2 est la 1ere cellule de la plage où trouver le nombre déclencheur
Bien respecter le$ avant la reference de colonne
Pour plusieurs conditions la formule sera =OU($B2=18;$B2=20;$B2=40)
Cdlmnt
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
bamboougo
Messages postés
13
Date d'inscription
lundi 4 mars 2013
Statut
Membre
Dernière intervention
5 avril 2013
5 mars 2013 à 10:39
5 mars 2013 à 10:39
Voici le code de la feuille à enregistrer, il n'y a pas de lignes concernant une restriction à l'enregistrement.
Le fichier est sur un réseau ? Est ce le probleme ?
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif Vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("SPERIA 106").Select
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("BOBST SP 102 CER").Select
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("BOBST SP 103 E").Select
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("BOBST SP 76-E").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("SPERIA 106").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("BOBST SP 102 CER").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("BOBST SP 103 E").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("BOBST SP 76-E").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,5,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L165"), Type:=xlFillDefault
Range("L7:L165").Select
Sheets("SPERIA 106").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,4,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L496"), Type:=xlFillDefault
Range("L7:L496").Select
Range("L7").Select
Sheets("BOBST SP 102 CER").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,3,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L68"), Type:=xlFillDefault
Range("L7:L68").Select
ActiveWindow.SmallScroll Down:=-51
ActiveWindow.Zoom = 40
ActiveWindow.Zoom = 55
ActiveWindow.SmallScroll Down:=-9
ActiveWindow.SmallScroll ToRight:=-5
Sheets("BOBST SP 103 E").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP('Objectif découpe'!R2C1:R46C5,2,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L109"), Type:=xlFillDefault
Range("L7:L109").Select
ActiveWindow.SmallScroll Down:=-105
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,2,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L109"), Type:=xlFillDefault
Range("L7:L109").Select
ActiveWindow.SmallScroll Down:=-114
Sheets("BOBST SP 76-E").Select
Range("A1:N1").Select
End Sub
Merci pour votre aide.
Le fichier est sur un réseau ? Est ce le probleme ?
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif Vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("SPERIA 106").Select
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("BOBST SP 102 CER").Select
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("BOBST SP 103 E").Select
Range("L6").Select
ActiveCell.FormulaR1C1 = "Objectif vitesse"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L6").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Sheets("BOBST SP 76-E").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("SPERIA 106").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("BOBST SP 102 CER").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("BOBST SP 103 E").Select
Range("L6").Select
With Selection.Font
.Name = "Arial"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Sheets("BOBST SP 76-E").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,5,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L165"), Type:=xlFillDefault
Range("L7:L165").Select
Sheets("SPERIA 106").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,4,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L496"), Type:=xlFillDefault
Range("L7:L496").Select
Range("L7").Select
Sheets("BOBST SP 102 CER").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,3,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L68"), Type:=xlFillDefault
Range("L7:L68").Select
ActiveWindow.SmallScroll Down:=-51
ActiveWindow.Zoom = 40
ActiveWindow.Zoom = 55
ActiveWindow.SmallScroll Down:=-9
ActiveWindow.SmallScroll ToRight:=-5
Sheets("BOBST SP 103 E").Select
Range("L7").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP('Objectif découpe'!R2C1:R46C5,2,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L109"), Type:=xlFillDefault
Range("L7:L109").Select
ActiveWindow.SmallScroll Down:=-105
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'Objectif découpe'!R2C1:R46C5,2,FALSE)"
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L109"), Type:=xlFillDefault
Range("L7:L109").Select
ActiveWindow.SmallScroll Down:=-114
Sheets("BOBST SP 76-E").Select
Range("A1:N1").Select
End Sub
Merci pour votre aide.