N
nimbus le truand
Guest
Bonjour,
J’ai développé une macro qui récupère des données d’un fichier Excel externe pour le ramener vers un fichier comprenant la mise en forme des données.
Seulement le problème est que en mode ‘run’, Excel déraille et ne s’arrête plus. Au contraire en mode ‘step by step’, avec des points d’arrêt avant les 2 fonctions FOR, y’a pas de problème.
Je n’ai pas vue de solutions, mais si quelqu’un sur ce forum est capable de comprendre et de m’aider, je serai vraiment ravi.
Si vous avez besoins de plus de renseignements, n’hésitez pas et contactez moi. De plus, si vous voyez des améliorations à apporter au code, no souci je suis preneur.
Merci beaucoup d’avance
Nimbus
P.S : voici le code de ma macro et le fichier joint est le fichier où sont piochées les données (à ouvrir au début de la macro)
' Déclaration du variant feuille de travail
Dim Feuil_Ori As Worksheet
' Déclaration du nom du client
Dim NomClient
Sub RemplissageTableau()
'
' RemplissageTableau Macro
'
' Macro enregistrée le 14/06/2004
' Permettant d'avoir des résultats sur les jours d'intervention et les procédés
' Désactivation de l'affichage écran pour plus de rapidité
Application.ScreenUpdating = False
' Positionnement de la feuille de travail sur le classeur d'origine de la macro, feuille 1
Set Feuil_Ori = ThisWorkbook.Sheets(1) 'feuille de travail à préciser
'**************** Travail sur le fichier d'exportation de PB ****************
' Définit le répertoire courant du fichier tampon (exportation PB)
TempDrive = "Z"
ThePath = "Z:\Exploitation"
ChDrive TempDrive
ChDir ThePath
' Ouvre le fichier tampon (exportation PB)
FileToOpen = Application.GetOpenFilename("Fichier Excel (*.xls), *.xls")
' Condition d'exécution
If Not (FileToOpen = False) Then ThisWorkbook.FollowHyperlink FileToOpen Else Exit Sub
' Récupération du Nom du Client & Suppression de la colonne Client
NomClient = Range("A2")
Columns("A:A").ClearContents
' Mise en forme "date de détection" de jj/mm/yyyy vers dd-mmmm-yy
Columns("K:K").NumberFormat = "[$-40C]d-mmm-yy;@"
Columns("N:N").NumberFormat = "[$-40C]d-mmm-yy;@"
'Tri les données selon les dates d'Intervention (tableau avec titre de colonne)
' puis procédés puis unités traitées
Cells.Sort Key1:=Range("N2"), Order1:=xlAscending, _
Key2:=Range("J2"), Order2:=xlAscending, _
Key3:=Range("O2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' Suppression des colonnes inintéressantes
Columns("A:I").Delete Shift:=xlToLeft
Columns("B
").Delete Shift:=xlToLeft
Columns("D:E").Delete Shift:=xlToLeft
' Copie les données dans la feuille de travail
Columns("C:C").CurrentRegion.Copy Destination:=Feuil_Ori.Range("A18")
Application.CutCopyMode = False
'********************* Travail sur le fichier Rapport Prototype *********************
' Active le fichier Rapport
With Feuil_Ori
' Déplacement des colonnes au bon endroit
.Range("C18:C65536").Copy Destination:=Feuil_Ori.Range("E18:E65536")
.Range("A18:A65536").Copy Destination:=Feuil_Ori.Range("C18:C65536")
.Range("B18:B65536").Cut Destination:=Feuil_Ori.Range("A18:A65536")
' Suppression de la ligne entre les titres et le tableau
.Rows("18:18").Delete Shift:=xlUp
' Nom du client dans l'entete
.[C8].Value = NomClient
'********************************************************************************
'* Fonction ComptageDate *
'* permettant d'incrémenter un compteur à chaque changement de date consécutive *
'********************************************************************************
Dim celluleDateActive As Range
Dim celluleDateSuivante As Range
Dim celluleProcédéActive As Range
Dim celluleProcédéSuivante As Range
Dim celluleUnitéActive As Range
Dim Counter As Integer
Dim Somme As Single
Dim Ligne As Long
Counter = 1
Somme = 0
For Ligne = 1 To 65515
Set celluleDateActive = .Range("A17").Offset(Ligne, 0)
Set celluleDateSuivante = .Range("A18").Offset(Ligne, 0)
Set celluleProcédéActive = .Range("C17").Offset(Ligne, 0)
Set celluleProcédéSuivante = .Range("C18").Offset(Ligne, 0)
Set celluleUnitéActive = .Range("E17").Offset(Ligne, 0)
If (IsEmpty(celluleDateActive) And Counter = 1) Then
Counter = 0
[G13].Value = Counter: Exit For
Else:
If celluleDateSuivante = celluleDateActive Then
Counter = Counter
If celluleProcédéActive = celluleProcédéSuivante Then
Somme = (Somme + celluleUnitéActive)
Else:
Somme = (Somme + celluleUnitéActive)
celluleUnitéActive.Offset(0, 1).Value = Somme
Somme = 0
End If
Else:
Somme = (Somme + celluleUnitéActive)
celluleUnitéActive.Offset(0, 1).Value = Somme
Somme = 0
If IsEmpty(celluleDateSuivante) Then
.[G13].Value = Counter: Exit For
Else: Counter = (Counter + 1)
End If
End If
End If
Next Ligne
' Suppression des lignes avec la cellule "Somme unité / procédé / jour" vide
Dim celluleSommeUnitéActive As Range
For Ligne = 1 To 65515
Set celluleDateActive = .Range("A17").Offset(Ligne, 0)
Set celluleSommeUnitéActive = .Range("F17").Offset(Ligne, 0)
If IsEmpty(celluleDateActive) Then
Exit For
Else:
If IsEmpty(celluleSommeUnitéActive) Then
Rows(celluleSommeUnitéActive.Row).Delete
Ligne = Ligne - 1
End If
End If
Next Ligne
' Date de début et de fin des interventions
.[C10].FormulaR1C1 = "=MIN(C[-2])"
.[C11].FormulaR1C1 = "=MAX(C[-2])"
'******************* Sauvegarde le fichier Rapport pour le Client *******************
Dim nomfichier As String, NomFichierFinal As String
' Définit le répertoire courant des fichiers clients
TempDrive = "Y"
ThePath = "Y:\"
ChDrive TempDrive
ChDir ThePath
' Sauvegarde le fichier sous le nom courant du client
ThisWorkbook.Activate
' Récupère le nom du fichier sans l'extension
nomfichier = ThisWorkbook.Name 'Récupère le nom
If InStrRev(nomfichier, ".", -1, 1) > 0 Then nomfichier = Left(nomfichier, _
InStrRev(nomfichier, ".", -1, 1) - 1) 'Enlève toute extension présente
End With
' Sauvegarde le fichier avec le numéro sous le forme : "NomFichier NumDevis.xls ""
NomFichierFinal = Application.GetSaveAsFilename(nomfichier & " " & NomClient & ".xls", _
FileFilter:="Fichiers Excel (*.xls),*.xls", Title:="Enregistrement") 'dialogue enregistrer sous
If Not (NomFichierFinal = "Faux") Then ThisWorkbook.SaveAs Filename:=NomFichierFinal _
Else MsgBox "Annulation, fichier non enregistré ", vbInformation 'sauvegarde le fichier si pas d'annulation"
End Sub
J’ai développé une macro qui récupère des données d’un fichier Excel externe pour le ramener vers un fichier comprenant la mise en forme des données.
Seulement le problème est que en mode ‘run’, Excel déraille et ne s’arrête plus. Au contraire en mode ‘step by step’, avec des points d’arrêt avant les 2 fonctions FOR, y’a pas de problème.
Je n’ai pas vue de solutions, mais si quelqu’un sur ce forum est capable de comprendre et de m’aider, je serai vraiment ravi.
Si vous avez besoins de plus de renseignements, n’hésitez pas et contactez moi. De plus, si vous voyez des améliorations à apporter au code, no souci je suis preneur.
Merci beaucoup d’avance
Nimbus
P.S : voici le code de ma macro et le fichier joint est le fichier où sont piochées les données (à ouvrir au début de la macro)
' Déclaration du variant feuille de travail
Dim Feuil_Ori As Worksheet
' Déclaration du nom du client
Dim NomClient
Sub RemplissageTableau()
'
' RemplissageTableau Macro
'
' Macro enregistrée le 14/06/2004
' Permettant d'avoir des résultats sur les jours d'intervention et les procédés
' Désactivation de l'affichage écran pour plus de rapidité
Application.ScreenUpdating = False
' Positionnement de la feuille de travail sur le classeur d'origine de la macro, feuille 1
Set Feuil_Ori = ThisWorkbook.Sheets(1) 'feuille de travail à préciser
'**************** Travail sur le fichier d'exportation de PB ****************
' Définit le répertoire courant du fichier tampon (exportation PB)
TempDrive = "Z"
ThePath = "Z:\Exploitation"
ChDrive TempDrive
ChDir ThePath
' Ouvre le fichier tampon (exportation PB)
FileToOpen = Application.GetOpenFilename("Fichier Excel (*.xls), *.xls")
' Condition d'exécution
If Not (FileToOpen = False) Then ThisWorkbook.FollowHyperlink FileToOpen Else Exit Sub
' Récupération du Nom du Client & Suppression de la colonne Client
NomClient = Range("A2")
Columns("A:A").ClearContents
' Mise en forme "date de détection" de jj/mm/yyyy vers dd-mmmm-yy
Columns("K:K").NumberFormat = "[$-40C]d-mmm-yy;@"
Columns("N:N").NumberFormat = "[$-40C]d-mmm-yy;@"
'Tri les données selon les dates d'Intervention (tableau avec titre de colonne)
' puis procédés puis unités traitées
Cells.Sort Key1:=Range("N2"), Order1:=xlAscending, _
Key2:=Range("J2"), Order2:=xlAscending, _
Key3:=Range("O2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' Suppression des colonnes inintéressantes
Columns("A:I").Delete Shift:=xlToLeft
Columns("B
").Delete Shift:=xlToLeftColumns("D:E").Delete Shift:=xlToLeft
' Copie les données dans la feuille de travail
Columns("C:C").CurrentRegion.Copy Destination:=Feuil_Ori.Range("A18")
Application.CutCopyMode = False
'********************* Travail sur le fichier Rapport Prototype *********************
' Active le fichier Rapport
With Feuil_Ori
' Déplacement des colonnes au bon endroit
.Range("C18:C65536").Copy Destination:=Feuil_Ori.Range("E18:E65536")
.Range("A18:A65536").Copy Destination:=Feuil_Ori.Range("C18:C65536")
.Range("B18:B65536").Cut Destination:=Feuil_Ori.Range("A18:A65536")
' Suppression de la ligne entre les titres et le tableau
.Rows("18:18").Delete Shift:=xlUp
' Nom du client dans l'entete
.[C8].Value = NomClient
'********************************************************************************
'* Fonction ComptageDate *
'* permettant d'incrémenter un compteur à chaque changement de date consécutive *
'********************************************************************************
Dim celluleDateActive As Range
Dim celluleDateSuivante As Range
Dim celluleProcédéActive As Range
Dim celluleProcédéSuivante As Range
Dim celluleUnitéActive As Range
Dim Counter As Integer
Dim Somme As Single
Dim Ligne As Long
Counter = 1
Somme = 0
For Ligne = 1 To 65515
Set celluleDateActive = .Range("A17").Offset(Ligne, 0)
Set celluleDateSuivante = .Range("A18").Offset(Ligne, 0)
Set celluleProcédéActive = .Range("C17").Offset(Ligne, 0)
Set celluleProcédéSuivante = .Range("C18").Offset(Ligne, 0)
Set celluleUnitéActive = .Range("E17").Offset(Ligne, 0)
If (IsEmpty(celluleDateActive) And Counter = 1) Then
Counter = 0
[G13].Value = Counter: Exit For
Else:
If celluleDateSuivante = celluleDateActive Then
Counter = Counter
If celluleProcédéActive = celluleProcédéSuivante Then
Somme = (Somme + celluleUnitéActive)
Else:
Somme = (Somme + celluleUnitéActive)
celluleUnitéActive.Offset(0, 1).Value = Somme
Somme = 0
End If
Else:
Somme = (Somme + celluleUnitéActive)
celluleUnitéActive.Offset(0, 1).Value = Somme
Somme = 0
If IsEmpty(celluleDateSuivante) Then
.[G13].Value = Counter: Exit For
Else: Counter = (Counter + 1)
End If
End If
End If
Next Ligne
' Suppression des lignes avec la cellule "Somme unité / procédé / jour" vide
Dim celluleSommeUnitéActive As Range
For Ligne = 1 To 65515
Set celluleDateActive = .Range("A17").Offset(Ligne, 0)
Set celluleSommeUnitéActive = .Range("F17").Offset(Ligne, 0)
If IsEmpty(celluleDateActive) Then
Exit For
Else:
If IsEmpty(celluleSommeUnitéActive) Then
Rows(celluleSommeUnitéActive.Row).Delete
Ligne = Ligne - 1
End If
End If
Next Ligne
' Date de début et de fin des interventions
.[C10].FormulaR1C1 = "=MIN(C[-2])"
.[C11].FormulaR1C1 = "=MAX(C[-2])"
'******************* Sauvegarde le fichier Rapport pour le Client *******************
Dim nomfichier As String, NomFichierFinal As String
' Définit le répertoire courant des fichiers clients
TempDrive = "Y"
ThePath = "Y:\"
ChDrive TempDrive
ChDir ThePath
' Sauvegarde le fichier sous le nom courant du client
ThisWorkbook.Activate
' Récupère le nom du fichier sans l'extension
nomfichier = ThisWorkbook.Name 'Récupère le nom
If InStrRev(nomfichier, ".", -1, 1) > 0 Then nomfichier = Left(nomfichier, _
InStrRev(nomfichier, ".", -1, 1) - 1) 'Enlève toute extension présente
End With
' Sauvegarde le fichier avec le numéro sous le forme : "NomFichier NumDevis.xls ""
NomFichierFinal = Application.GetSaveAsFilename(nomfichier & " " & NomClient & ".xls", _
FileFilter:="Fichiers Excel (*.xls),*.xls", Title:="Enregistrement") 'dialogue enregistrer sous
If Not (NomFichierFinal = "Faux") Then ThisWorkbook.SaveAs Filename:=NomFichierFinal _
Else MsgBox "Annulation, fichier non enregistré ", vbInformation 'sauvegarde le fichier si pas d'annulation"
End Sub
