cs_Elberton
Messages postés25Date d'inscriptionmercredi 20 août 2008StatutMembreDernière intervention28 septembre 2019
-
14 févr. 2012 à 11:46
Utilisateur anonyme -
26 févr. 2012 à 03:28
Bonjour à tous, j'ai un soucis dans une feuille excel.
Ce fichiers comporte plusieurs feuilles. Dans une de ses feuilles, on va chercher des infos à l'aide d'un bouton qui s'appelle Bordereau de vente. Il va chercher toutes les infos dans la feuille déboursé, qui contient diverses données et prix.
Cependant sur un excel 2000 ou office xp cela fonctionne. Mais cela ne fonctionne plus avec un excel 2003 2007 2010.
Cela bloque à partir de ActiveCell.FormulaR1C1 = "'RECAPITULATIF DU BORDEREAU".
j'ai l'erreur suivante : erreur d’exécution 1004. impossible de coller les informations car les zones copié et de collage sont de formes et de taille différentes.
voici la fonction problématique :
Sub Bordereau_de_vente()
Application.ScreenUpdating = False
'Calcul_de_larrondi
Totaliser_par_chapitre
'Figer les décimales en prévision de l'Euro
'Dim Message, Titre, Défaut, Lavaleur
'Message = "Saisissez le nombre de décimales que vous voulez voir apparaître sur le bordereau de vente"
'Titre = "Nombre de décimales"
'Défaut = 0
'Lavaleur = InputBox(Message, Titre, Défaut)
'Sheets("Feuille de vente").Select
'Range("D7").Select
'ActiveCell.Formula = Lavaleur
'Range("C7").Select
' Fin de sous-programme
Sheets("Bordereau de vente").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A2").Select
Sheets("Déboursé").Select
ActiveSheet.Unprotect
Range("A2").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets("Bordereau de vente").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("B:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("B:D").EntireColumn.AutoFit
Columns("E:M").Select
Selection.Delete Shift:=xlToLeft
Range("F2").Select
ActiveCell.FormulaR1C1 = "Prix" & Chr(10) & "Total"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("E2:F2").Select
With Selection
.HorizontalAlignment = xlGeneral
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("F2").Select
ActiveWindow.DisplayZeros = False
'Saisie de la formule de la vente totale
Dim Nbl, Lcpt
Selection.CurrentRegion.Select
Nbl = Selection.Rows.Count - 1
Lcpt = 1
Range("F3").Select
While Lcpt <= Nbl
ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
ActiveCell.Offset(1, 0).Activate
Lcpt = Lcpt + 1
Wend
Sheets("Déboursé").Select
Range("A2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Bordereau de vente").Select
Columns("E:F").Select
Range("F3").Activate
Selection.NumberFormat = "#,##0.00 _F"
Range("A1:B1").Select
ActiveCell.FormulaR1C1 = _
"=""CRYSTAL ""&Région&""" & Chr(10) & """&IF(ISBLANK(Entité),"""",Entité)"
Range("A1:B1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = True
End With
With Selection.Font
.FontStyle = "Gras"
End With
Range("C1:F1").Select
ActiveCell.FormulaR1C1 = "=Désignation&""" & Chr(10) & """&Date_remise"
Range("C1:F1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = True
End With
With Selection.Font
.FontStyle = "Gras"
End With
Rows("1:1").Select
Selection.RowHeight = 50
Cells.Select
With Selection.Font
.Name = "Times New Roman"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1:B1").Select
ColleValeur
Range("C1:F1").Select
Application.CutCopyMode = False
ColleValeur_Annule
Columns("A:F").Select
Range("A3").Activate
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With
Encadrer_lavente
Derniere_Cellule = Range("F2").End(xlDown).Address
Range(Derniere_Cellule).Select
ActiveCell.Offset(1, -5).Range("A1").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
'Préparation de la récapitulation par chapitre
'coordonnées de la cellule coin haut gauche de la récapitulation
Coin_hg = ActiveCell.Address
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "'RECAPITULATIF DU BORDEREAU"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = True
ActiveCell.Offset(2, -1).Range("A1").Copy
'récapitulation par chapitre colonne A
Sheets("Récapitulatif par chapitre").Select
Derniere_Cellule = Range("A3").End(xlDown).Address
Range("A3:" & Derniere_Cellule).Select
Selection.Copy
Sheets("Bordereau de vente").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Range("A1").Copy
'récapitulation par chapitre colonne B
Sheets("Récapitulatif par chapitre").Select
Derniere_Cellule = Range("C3").End(xlDown).Address
Derniere_Cellule = "$B$" & Mid(Derniere_Cellule, 4, 5)
Range("B3:" & Derniere_Cellule).Select
Selection.Copy
Sheets("Bordereau de vente").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(0, 4).Range("A1").Copy
'récapitulation par chapitre colonne H
Sheets("Récapitulatif par chapitre").Select
Derniere_Cellule = Range("A3").End(xlDown).Address
Derniere_Cellule = "$G$" & Mid(Derniere_Cellule, 4, 5)
Range("G3:" & Derniere_Cellule).Select
Selection.Copy
Range("A2").Select 'on repositionne le pointeur en haut à gauche
Sheets("Bordereau de vente").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Columns("A:F").EntireColumn.AutoFit
Range(Coin_hg).Select
Selection.RowHeight = 50
ActiveCell.Offset(2, 0).Range("A1").Select
Selection.CurrentRegion.Select
Nb_lignes = Selection.Rows.Count - 1
Selection.RowHeight = 30
ActiveCell.Offset(Nb_lignes, 5).Range("A1").Copy
Coin_bd = ActiveCell.Address 'coin bas droit de la zone
Range(Coin_hg & ":" & Coin_bd).Select
Ajoute_bordure
Range(Coin_bd).Select
ActiveCell.Offset(0, -4).Range("A1").Select
ActiveCell.FormulaR1C1 = "'MONTANT H.T."
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.ClearContents
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=""T.V.A. ""&TVA&"" %"""
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
ColleValeur_Annule
ActiveCell.Offset(0, 4).Range("A1").Select
ActiveCell.FormulaR1C1 = "=ROUND(R[-1]C*RIGHT(RC[-4],6),2)"
ActiveCell.Offset(1, -4).Range("A1").Select
ActiveCell.FormulaR1C1 = "'TOTAL T.T.C."
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
ActiveCell.Offset(0, 4).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-2]C+R[-1]C"
Range(Coin_bd).Select
ActiveCell.Offset(0, -5).Range("A1").Select
ActiveCell.Range("A1:F1").Select
Efface_bordure
ActiveCell.Range("A1:F3").Select
Ajoute_bordure
Selection.RowHeight = 40
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
ActiveCell.Select
Range("F3").Select
Selection.ColumnWidth = 25
Range("A2").Select
End Sub
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 24 févr. 2012 à 07:24
Bonjour, mjpmjp,
J'ai modifié ce qu'il y avait à modifier
Non ! tu n'as fait que corriger les seules lignes dont t'a parlé bigfish, en les remplaçant par ce qu'il t'a montré, mais sans comprendre du tout ce qu'il a pris la peine de t'exposer à propos des select, etc...
Et on voit bien que tu recommences un peu plus loin (les quelques lignes de code que tu viens de nous montrer en sont la preuve la plus criante !
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
Vous n’avez pas trouvé la réponse que vous recherchez ?
ucfoutu
Messages postés18038Date d'inscriptionlundi 7 décembre 2009StatutModérateurDernière intervention11 avril 2018211 24 févr. 2012 à 07:26
Pardon :
Bonjour, mjpmjp, Elberton
Ce qui ne m'empêche par ailleurs pas de dire également bonjour à mjpmjp.
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient
En plus des judicieux conseils indiqués plus haut. Mets un point d'arrêt (F9) sur la ligne qui sélectionne la plage à copier et vérifie que tu sélectionnes la bonne plage. Mets un autre point d'arrêt sur la ligne qui cause l'horreur. Sauf horreur de ma part, tu devrais être capable de voir si tu copies à la bonne place et si tu colles à la bonne place.
Et puis, de toute évidence ton code sort directement de l'enregistreur de macros. Comme c'est un fidèle perroquet qui ramasse tout. Toutes les propriétés ont une valeur par défaut et très peu, voire aucune, de ces propriétés n'est modifiée.
Cela veut donc dire que tu peux réduire considérablement le nombre de lignes, en ôtant tout ce que toi tu n'as pas choisi fait ou changé en enregistrant ta macro, ou après l'enregistrement.
Attention avec les End.xlup, End.xldown etc... Ce sont des choses très pratiques, mais, il suffit de cliquer, même accidentellement, sur une cellule, même, et surtout, vide pour que la plage soit automatiquement agrandie.