Macro Excel 2003 ne fonctionne plus sous 2007/2010

bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022
- 27 nov. 2013 à 08:18
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
- 11 déc. 2013 à 17:29
Bonjour,
J'ai la macro ci-dessous que j'utilisais sur des machines équipés de Excel 2003 pour recalculer une nomenclature.
Lorsque je lances cette macro sur un Excel 2007 ou 2010 les colonnes où le montant étaient recalculé ne se fait plus. J'y ai passé des heures mais je ne trouve pas.
Avez-vous une idée ? Merci d'avance

Je peux vous fournir un exemple de fichier Excel également mais sur quel lien le stocker ?


Sub suppr_lignes_vides()
'11/01/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereligne To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub

Sub groupe_niveaux_nomenclature()
'11/01/2009
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
derniereligne = ActiveSheet.UsedRange.Rows.Count
'Application.ScreenUpdating = False
If Cells(8, 1) <> 1 Then '9 avant PSB
MsgBox "erreur niveau 1"
Else
For niveau = 1 To 3
index1 = 0
For r = 9 To derniereligne + 1 '10 avant PSB
If Cells(r, 1) > niveau Then
If index1 = 0 Then index1 = r
ElseIf index1 <> 0 Then
index2 = r - 1
Rows(CStr(index1 & ":" & index2)).Group
index1 = 0
End If
Next r
Next niveau
End If
End Sub

Sub dec_gauche_1er_cellule_vides()
'11/01/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereligne To 7 Step -1 '8 avant PSB
If IsEmpty(Cells(r, 1)) Then Cells(r, 1).Delete Shift:=xlToLeft
Next r
End Sub
Sub mise_en_forme_nomenclature()
'25/05/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

'decale la première cellule vide
For r = derniereligne To 7 Step -1 '8 avant PSB
If IsEmpty(Cells(r, 1)) Then Cells(r, 1).Delete Shift:=xlToLeft
Next r

'colorie selon les niveaux
With Columns("A:A")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="1"
.FormatConditions(1).Interior.ColorIndex = 16
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="2"
.FormatConditions(2).Interior.ColorIndex = 48
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="3"
.FormatConditions(3).Interior.ColorIndex = 15
End With

'filtre automatique
Range("A7:I7").Font.Bold = True '8 avant PSB
Range(CStr("A7:I" & derniereligne)).AutoFilter '8 avant PSB

'bordure
Range(CStr("A7:J" & derniereligne)).Select '8 avant PSB
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'largeur des colonnes
Columns("A:A").ColumnWidth = 6
Columns("B:B").ColumnWidth = 14
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").ColumnWidth = 5
Columns("E:E").ColumnWidth = 4
Columns("F:F").ColumnWidth = 5
Columns("G:G").ColumnWidth = 10
Columns("H:H").EntireColumn.AutoFit

'supprime 3 dernieres lignes
Rows(derniereligne).Delete
Rows(derniereligne - 1).Delete
Rows(derniereligne - 2).Delete

End Sub

Sub mise_en_forme_prix_de_revient()
'16/09/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = 8 To derniereligne '9 avant PSB
'colonne option à 0 et copie montant total
Cells(r, 11).Value = 1
niveau = Cells(r, 1).Value
Cells(r, 11 + niveau).FormulaR1C1 = "=RC[" & CStr(-1 - niveau) & "]*RC[" & CStr(-niveau) & "]"
Next r

End Sub

Sub prix_sous_ensemble2()
'16/0/2012
'07/05/2012 pas de calcul de sous ensemble si article coût existe

derniereligne = ActiveSheet.UsedRange.Rows.Count
For niveau = 4 To 2 Step -1
index1 = 0
For r = 9 To derniereligne + 1 '10 avant PSB
If Cells(r, 1) >= niveau Then
If index1 = 0 Then index1 = r
ElseIf index1 <> 0 Then
If IsEmpty(Cells(index1 - 1, 10)) Then
Cells(index1 - 1, 10 + niveau).FormulaR1C1 = "=R[0]C[" & CStr(1 - niveau) & "]*sum(R[1]C[1]:R[" & CStr(r - index1) & "]C[1])"
Cells(index1 - 1, 10 + niveau).Font.Bold = True
End If
index1 = 0
End If
Next r
Next niveau

With Range("L7") '8 avant PSB
.Formula = "=SUM(R8C:R" & CStr(derniereligne) & "C)" '9 avant PSB
.Font.Bold = True
.Font.ColorIndex = 3
End With
End Sub

Sub prix_revient_nomenclature()
'
' Macro enregistrée le par PLB le 14/05/12
'
Dim Fxls, Fcsv As String
Fxls = ActiveWorkbook.FullName
Fcsv = Left(Fxls, Len(Fxls) - 3) + "csv"
ActiveWorkbook.SaveAs Filename:=Fcsv, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Dim appWD As Word.Application
On Error Resume Next ' Retarde la récupération
' d'erreur.
Set appWD = GetObject(, "Word.Application")
If Err.Number <> 0 Then
' utilise CreateObject si Word n'est pas ouvert.
Set appWD = CreateObject("Word.Application")
End If
Err.Clear ' Efface l'objet Err si une erreur s'est
' produite.
With appWD
'.Visible = True
.Documents.Open (Fcsv)
.Run MacroName:="purgevirg"
.Documents.Save
.Documents.Close
.Quit
End With
Set appWD = Nothing
Workbooks.Open Filename:=Fcsv, Format:=2
Call suppr_lignes_vides
Call mise_en_forme_nomenclature
Call groupe_niveaux_nomenclature
Call mise_en_forme_prix_de_revient
Call prix_sous_ensemble2
ActiveWorkbook.SaveAs Filename:=Fxls, _
FileFormat:=xlWorkbookNormal
Kill (Fcsv)
End Sub

15 réponses

ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
27 nov. 2013 à 08:30
Bonjour,
Je déplace cette discussion vers VBA (VBV.Net, la présente section, n'est pas VBA et est très différent de VBA. Prends-en s'il te plait bonne notre pour tes prochaines discussions VBA).
Veux-tu bien par ailleurs, s'il te plait, remettre ici ton code entre balises code (la 4ème icône dans la barre au-dessus du message que tu rédiges) et indenté.
Il est, en l'état, trop pénible à lire et à suivre.
0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

27 nov. 2013 à 11:23
Sub suppr_lignes_vides() 
'11/01/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereligne To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub

Sub groupe_niveaux_nomenclature()
'11/01/2009
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
derniereligne = ActiveSheet.UsedRange.Rows.Count
'Application.ScreenUpdating = False
If Cells(8, 1) <> 1 Then '9 avant PSB
MsgBox "erreur niveau 1"
Else
For niveau = 1 To 3
index1 = 0
For r = 9 To derniereligne + 1 '10 avant PSB
If Cells(r, 1) > niveau Then
If index1 = 0 Then index1 = r
ElseIf index1 <> 0 Then
index2 = r - 1
Rows(CStr(index1 & ":" & index2)).Group
index1 = 0
End If
Next r
Next niveau
End If
End Sub

Sub dec_gauche_1er_cellule_vides()
'11/01/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereligne To 7 Step -1 '8 avant PSB
If IsEmpty(Cells(r, 1)) Then Cells(r, 1).Delete Shift:=xlToLeft
Next r
End Sub
Sub mise_en_forme_nomenclature()
'25/05/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

'decale la première cellule vide
For r = derniereligne To 7 Step -1 '8 avant PSB
If IsEmpty(Cells(r, 1)) Then Cells(r, 1).Delete Shift:=xlToLeft
Next r

'colorie selon les niveaux
With Columns("A:A")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="1"
.FormatConditions(1).Interior.ColorIndex = 16
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="2"
.FormatConditions(2).Interior.ColorIndex = 48
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="3"
.FormatConditions(3).Interior.ColorIndex = 15
End With

'filtre automatique
Range("A7:I7").Font.Bold = True '8 avant PSB
Range(CStr("A7:I" & derniereligne)).AutoFilter '8 avant PSB

'bordure
Range(CStr("A7:J" & derniereligne)).Select '8 avant PSB
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'largeur des colonnes
Columns("A:A").ColumnWidth = 6
Columns("B:B").ColumnWidth = 14
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").ColumnWidth = 5
Columns("E:E").ColumnWidth = 4
Columns("F:F").ColumnWidth = 5
Columns("G:G").ColumnWidth = 10
Columns("H:H").EntireColumn.AutoFit

'supprime 3 dernieres lignes
Rows(derniereligne).Delete
Rows(derniereligne - 1).Delete
Rows(derniereligne - 2).Delete

End Sub

Sub mise_en_forme_prix_de_revient()
'16/09/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = 8 To derniereligne '9 avant PSB
'colonne option à 0 et copie montant total
Cells(r, 11).Value = 1
niveau = Cells(r, 1).Value
Cells(r, 11 + niveau).FormulaR1C1 = "=RC[" & CStr(-1 - niveau) & "]*RC[" & CStr(-niveau) & "]"
Next r

End Sub

Sub prix_sous_ensemble2()
'16/0/2012
'07/05/2012 pas de calcul de sous ensemble si article coût existe

derniereligne = ActiveSheet.UsedRange.Rows.Count
For niveau = 4 To 2 Step -1
index1 = 0
For r = 9 To derniereligne + 1 '10 avant PSB
If Cells(r, 1) >= niveau Then
If index1 = 0 Then index1 = r
ElseIf index1 <> 0 Then
If IsEmpty(Cells(index1 - 1, 10)) Then
Cells(index1 - 1, 10 + niveau).FormulaR1C1 = "=R[0]C[" & CStr(1 - niveau) & "]*sum(R[1]C[1]:R[" & CStr(r - index1) & "]C[1])"
Cells(index1 - 1, 10 + niveau).Font.Bold = True
End If
index1 = 0
End If
Next r
Next niveau

With Range("L7") '8 avant PSB
.Formula = "=SUM(R8C:R" & CStr(derniereligne) & "C)" '9 avant PSB
.Font.Bold = True
.Font.ColorIndex = 3
End With
End Sub

Sub prix_revient_nomenclature()
'
' Macro enregistrée le par PLB le 14/05/12
'
Dim Fxls, Fcsv As String
Fxls = ActiveWorkbook.FullName
Fcsv = Left(Fxls, Len(Fxls) - 3) + "csv"
ActiveWorkbook.SaveAs Filename:=Fcsv, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Dim appWD As Word.Application
On Error Resume Next ' Retarde la récupération
' d'erreur.
Set appWD = GetObject(, "Word.Application")
If Err.Number <> 0 Then
' utilise CreateObject si Word n'est pas ouvert.
Set appWD = CreateObject("Word.Application")
End If
Err.Clear ' Efface l'objet Err si une erreur s'est
' produite.
With appWD
'.Visible = True
.Documents.Open (Fcsv)
.Run MacroName:="purgevirg"
.Documents.Save
.Documents.Close
.Quit
End With
Set appWD = Nothing
Workbooks.Open Filename:=Fcsv, Format:=2
Call suppr_lignes_vides
Call mise_en_forme_nomenclature
Call groupe_niveaux_nomenclature
Call mise_en_forme_prix_de_revient
Call prix_sous_ensemble2
ActiveWorkbook.SaveAs Filename:=Fxls, _
FileFormat:=xlWorkbookNormal
Kill (Fcsv)
End Sub
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
27 nov. 2013 à 13:05
Code présenté entre balises, mais toujours pas indenté et donc toujours à lisibilité pénible !
Je vais attendre, donc ... (les maux de crâne sont à éviter, surtout en hiver et à mon âge !).
Désolé, bidounet84, mais c'est ainsi.
0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

27 nov. 2013 à 18:05
Qu'est ce que tu appelles "indenté" ?
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
27 nov. 2013 à 18:20
tu ne sais pas ce qu'est l'indentation ? ===>>
A lire, donc :
http://fr.wikipedia.org/wiki/Style_d%27indentation
Et à appliquer. Sans elle, la lecture d'un code est fastidieuse.
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
27 nov. 2013 à 18:24
Voilà, par exemple, ta première procédure, après indentation et mise entre balises code :
Sub suppr_lignes_vides() 
'11/01/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereligne To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

10 déc. 2013 à 14:48
Désolé pour le retard voici le code indenté :

Sub suppr_lignes_vides()
'11/01/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereligne To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub

Sub groupe_niveaux_nomenclature()
'11/01/2009
With ActiveSheet.Outline
.AutomaticStyles = False
.SummaryRow = xlAbove
.SummaryColumn = xlRight
End With
derniereligne = ActiveSheet.UsedRange.Rows.Count
'Application.ScreenUpdating = False
If Cells(8, 1) <> 1 Then '9 avant PSB
MsgBox "erreur niveau 1"
Else
For niveau = 1 To 3
index1 = 0
For r = 9 To derniereligne + 1 '10 avant PSB
If Cells(r, 1) > niveau Then
If index1 = 0 Then index1 = r
ElseIf index1 <> 0 Then
index2 = r - 1
Rows(CStr(index1 & ":" & index2)).Group
index1 = 0
End If
Next r
Next niveau
End If
End Sub

Sub dec_gauche_1er_cellule_vides()
'11/01/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereligne To 7 Step -1 '8 avant PSB
If IsEmpty(Cells(r, 1)) Then Cells(r, 1).Delete Shift:=xlToLeft
Next r
End Sub
Sub mise_en_forme_nomenclature()
'25/05/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

'decale la première cellule vide
For r = derniereligne To 7 Step -1 '8 avant PSB
If IsEmpty(Cells(r, 1)) Then Cells(r, 1).Delete Shift:=xlToLeft
Next r

'colorie selon les niveaux
With Columns("A:A")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="1"
.FormatConditions(1).Interior.ColorIndex = 16
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="2"
.FormatConditions(2).Interior.ColorIndex = 48
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="3"
.FormatConditions(3).Interior.ColorIndex = 15
End With

'filtre automatique
Range("A7:I7").Font.Bold = True '8 avant PSB
Range(CStr("A7:I" & derniereligne)).AutoFilter '8 avant PSB

'bordure
Range(CStr("A7:J" & derniereligne)).Select '8 avant PSB
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'largeur des colonnes
Columns("A:A").ColumnWidth = 6
Columns("B:B").ColumnWidth = 14
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").ColumnWidth = 5
Columns("E:E").ColumnWidth = 4
Columns("F:F").ColumnWidth = 5
Columns("G:G").ColumnWidth = 10
Columns("H:H").EntireColumn.AutoFit

'supprime 3 dernieres lignes
Rows(derniereligne).Delete
Rows(derniereligne - 1).Delete
Rows(derniereligne - 2).Delete

End Sub

Sub mise_en_forme_prix_de_revient()
'16/09/2009
derniereligne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False

For r = 8 To derniereligne '9 avant PSB
'colonne option à 0 et copie montant total
Cells(r, 11).Value = 1
niveau = Cells(r, 1).Value
Cells(r, 11 + niveau).FormulaR1C1 = "=RC[" & CStr(-1 - niveau) & "]*RC[" & CStr(-niveau) & "]"
Next r

End Sub

Sub prix_sous_ensemble2()
'16/0/2012
'07/05/2012 pas de calcul de sous ensemble si article coût existe

derniereligne = ActiveSheet.UsedRange.Rows.Count
For niveau = 4 To 2 Step -1
index1 = 0
For r = 9 To derniereligne + 1 '10 avant PSB
If Cells(r, 1) >= niveau Then
If index1 = 0 Then index1 = r
ElseIf index1 <> 0 Then
If IsEmpty(Cells(index1 - 1, 10)) Then
Cells(index1 - 1, 10 + niveau).FormulaR1C1 = "=R[0]C[" & CStr(1 - niveau) & "]*sum(R[1]C[1]:R[" & CStr(r - index1) & "]C[1])"
Cells(index1 - 1, 10 + niveau).Font.Bold = True
End If
index1 = 0
End If
Next r
Next niveau

With Range("L7") '8 avant PSB
.Formula = "=SUM(R8C:R" & CStr(derniereligne) & "C)" '9 avant PSB
.Font.Bold = True
.Font.ColorIndex = 3
End With
End Sub

Sub prix_revient_nomenclature()
'
' Macro enregistrée le par PLB le 14/05/12
'
Dim Fxls, Fcsv As String
Fxls = ActiveWorkbook.FullName
Fcsv = Left(Fxls, Len(Fxls) - 3) + "csv"
ActiveWorkbook.SaveAs Filename:=Fcsv, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close

Dim appWD As Word.Application

On Error Resume Next ' Retarde la récupération
' d'erreur.
Set appWD = GetObject(, "Word.Application")
If Err.Number <> 0 Then
' utilise CreateObject si Word n'est pas ouvert.
Set appWD = CreateObject("Word.Application")
End If
Err.Clear ' Efface l'objet Err si une erreur s'est
' produite.
With appWD
'.Visible = True
.Documents.Open (Fcsv)
.Run MacroName:="purgevirg"
.Documents.Save
.Documents.Close
.Quit
End With
Set appWD = Nothing
Workbooks.Open Filename:=Fcsv, Format:=2
Call suppr_lignes_vides
Call mise_en_forme_nomenclature
Call groupe_niveaux_nomenclature
Call mise_en_forme_prix_de_revient
Call prix_sous_ensemble2
ActiveWorkbook.SaveAs Filename:=Fxls, _
FileFormat:=xlWorkbookNormal
Kill (Fcsv)
End Sub
0
jordane45
Messages postés
36052
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
14 août 2022
358
10 déc. 2013 à 15:21
Bonjour,

Déjà, pour situer le (les) éventuel(s) soucis, as tu lancé cette macro en mode Pas à pas ?
Si oui, sur quelle(s) ligne(s) de code rencontre tu un souci ?

Sinon, quelles parties de ton code ne fonctionne plus ?


0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

10 déc. 2013 à 17:12
Le pas à pas ne me donne rien.
En fait à l'origine j'ai fichier exemple d'article avec un coût mais pas mis en forme.

Je lance cette macro à l'aide d'un raccourci, il me génère alors toutes les macros.
Mais au final avec Excel 2007 il met le fichier en forme mais les coûts articles disparaissent.

Voulez-vous que je vous donne un exemple de de fichier ?
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
10 déc. 2013 à 17:43
Je ne comprends pas cette phrase :
"Je lance cette macro à l'aide d'un raccourci, il me génère alors toutes les macros. "
Tu lances quelle macro ?
"Il" te "génère" quelles macros ? Que veux-tu dire par "génère" ?
Essaye s'il te plait de rester très technique dans tes explications. La sémantique est ici importante si tu veux que l'on te comprenne...

0
jordane45
Messages postés
36052
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
14 août 2022
358
10 déc. 2013 à 18:12

Voulez-vous que je vous donne un exemple de de fichier ?

Non.

Le pas à pas ne me donne rien.

C'est à dire ... ?
- Il ne se lance pas ?
- Il ne montre aucune erreur ?
- Les variables contiennent les valeurs attendues ?

Et surtout...
Quelle partie du code doit, selon vous, réaliser ce qui ne fontionne pas actuellement ????
( Nous donner l'intégralité du code sans nous indiquer quelle partie ne fonctionne pas... ne nous permettra pas de vous aider... !!! )
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
10 déc. 2013 à 18:52
Ce qui m'interpelle personnellement est qu'il n'y a dans ce code rien qui fonctionnerait sous 2003 et plus sous 2007 ou 2010.
on n'y voit par contre certaines choses qui pourraient expliquer non pas une erreur, mais une extrême lenteur de traitement, notamment si des formules ont été appliquées à la totalité d'une ou plusieurs colonnes. Et comme le nombre de lignes et colonnes sous 2003 était nettement plus faible que dans les versions ultérieures, ma foi, le usedrange est peut-être devenu très volumineux !
J'aimerais bien, à ce propos, savoir que qu'afficherait :
msgbox usedrange.address
(qui risque ne nous en dire bien long)
PS : je regrette par ailleurs que l'on ne voit nulle part dans ce code la déclaration de certaines variables
je regrette également une gestion d'erreur malencontreuse (qui se contente d'un Err.clear et laisse donc active la gestion d'erreur
0
jordane45
Messages postés
36052
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
14 août 2022
358
10 déc. 2013 à 19:37
Et au passage... juste pour m'ôter un petit doute... la colonne qui n'affiche plus ce que vous souhaitez... c'est laquelle ?

Autres questions :
- suite au passage sous 2007/2010.. le fichier que vous manipulez est toujours de la même forme (mêmes colonnes.. aux mêmes endroits.. ) ?

- Si vous relancez cette macro sur un Excel 2003 .. fonctionne t-elle toujours ou rencotrez vous le même souci ?




0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

11 déc. 2013 à 08:37
Je vais reprendre les interrogations dans l'ordre.
Pour le raccourci j'ai tout simplement mis dans le lancement de la macro un raccourci de lancement ctrl+M.
Quand je dis génère, en fait on export un document au format Excel d'un ERP (en l'occurrence Sage). Il s'agit d'une nomenclature valorisé. Le souci c'est comme elle est en multi niveau elle n'est pas exploitable en l'état.
Ainsi un utilisateur avait créé une macro pour chaque colonne se remette en forme et donne les mêmes informations.
C'est le fameux code que je vous ai transmis. Ce code a pour but de remettre les colonnes du fichier à l'identique.

La macro se lance bien dans les deux cas, en revanche sous Excel la nomenclature reste valorisé avec une colonne en montant et sous Excel 2010 cette colonne disparaît.

Pour moi c'est la partie à partir de
Sub prix_revient_nomenclature()
qui ne fonctionne pas.

Je suis désolé çà n'est pas moi qui ait créé ce code et je ne maîtrise pas complètement VB. La personne qui a créé le code n'est plus dans la société et je me suis rendu compte que les utilisateurs passé sous Excel 2007 ou 2010 ne peuvent plus utiliser cette macro.

Enfin le fichier manipuler est toujours le même c'est à dire que si j'exécute la macro sous 2003 le fichier est bien en forme et valorisé et en 2007 il est en forme mais la valorisation a disparu.
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
11 déc. 2013 à 10:13
"Pour moi c'est la partie à partir de Sub prix_revient_nomenclature()
qui ne fonctionne pas. "

Ouais... Et comme c'est elle qui lance toutes les autres !!... nous voilà bien avancés, tiens !

Je rappelle une demande simple que j'avais faite et qui est restée sans réponse, à savoir :
J'aimerais bien, à ce propos, savoir que qu'afficherait :
msgbox usedrange.address
(qui risque ne nous en dire bien long)

0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

11 déc. 2013 à 10:41
Où dois-je mettre ce msgbox comme demandé ?
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
11 déc. 2013 à 10:43
au tout début de la première sub (Sub prix_revient_nomenclature) que tu appelles, pardi !
Tu m'inquiètes beaucoup, toi...
0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

11 déc. 2013 à 10:59
Sur cette ligne
Dim appWD As Word.Application

On me met type défini par l'utilisateur non défini
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
11 déc. 2013 à 11:04
Déclare-la as object
Mais réponds d'abord à ma question relative à l'ampleur du usedrange !
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Modifié par ucfoutu le 11/12/2013 à 11:11
Et au passage : le fait que tu as cette erreur dénonce que l'appli d'origine avait une référence qui n'a pas été cochée sur les nouvelles applis, hein ... ou encore : que cette référence pointait vers UNE version de Office, qui n'est plus la même.
D'où l'énorme avantage de travailler en liaisons tardives.
0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

11 déc. 2013 à 11:38
Justement à l'origine cette macro a été faite sur Excel 2003, désormais de plus plus de mes utilisateurs sont sur 2007 ou 2010. C'est bien là le problème.

Quand à la déclaration As Object pour moi c'est déjà fait en ligne 181 du code. Et cela bloque en ligne 177.
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
11 déc. 2013 à 11:50
Désolé, mais là, trop c'est trop !
Tu me donnes l'impression de plus en plus nette (bien trop nette) que tu ne connais absolument RIEN de VBA et que ce que je te dis (nous te disons) est et restera pour toi pire que du chinois.
Je n'ai pas la force d'aider dans un tel contexte.
Bonne chance.
Un plus patient prendra, je l'espère pour toi, le relais de cette discussion qui risque fort de s'éterniser.
0
bidounet84
Messages postés
414
Date d'inscription
jeudi 28 août 2008
Statut
Membre
Dernière intervention
4 avril 2022

11 déc. 2013 à 11:54
J'ai été honnête depuis le début.
Cette macro a été créé par un utilisateur qui ne fait plus partie de la société.
Et de mon côté je ne suis pas un grand connaisseur de VB et j'essai de régler ce problème car nous ne pouvons plus valoriser nos nomenclatures avec les ordinateurs nouvellement équipés en 2007/2010.
0