Problème sur Application.Union

Résolu
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -  
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Voici mon code (ça plante sur la fin, pas besoin de tout lire, mais j'ai préféré tout mettre pour que vous puissiez mieux visualiser) : 

Sub Envoi_Repartition()

'**********************************************Déclaration / Création des variables************************************************************************

Dim DL_AFFRETEMENT As Long, DL_REPARTITION As Long, La_Date As String, xlBook As Workbook, i As Integer, x As Integer, Total As Double, TotalGeneral As Double, compteur As Integer

DL_AFFRETEMENT = Sheets("AFFRETEMENTS EN COURS").Cells(Application.Rows.Count, 1).End(xlUp).Row

La_Date = CStr(Date)

La_Date = Replace(La_Date, "/", ".")

Classeur_Actuel = ThisWorkbook.Name

'**********************************************Création et enregistrement du nouveau fichier Excel (rendu visible)*******************************************

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add


xlBook.SaveAs "K:\AFFRETEMENT EN COURS\REPARTITIONS\CALCUL DE REPARTITION DU " & La_Date & ".xlsx"

xlApp.Visible = True

'*********************************************Mise en place des titres sur le nouveau fichier Excel***********************************************************

With xlBook.Sheets(1)
    .Range("A1").Value = "CLIENT"
    .Range("B1").Value = "VILLE CH."
    .Range("C1").Value = "DPT"
    .Range("D1").Value = "VILLE LIV."
    .Range("E1").Value = "DPT"
    .Range("F1").Value = "DATE CH."
    .Range("G1").Value = "AFFRETE"
    .Range("H1").Value = "PRIX CLIENT"
    .Range("I1").Value = "PRIX AFFRETE"
    .Range("J1").Value = "MARGE"
    
    .Range("A1:J1").Font.Bold = True
End With

xlBook.Sheets(1).Cells.HorizontalAlignment = xlCenter

xlBook.Sheets(1).Range("A1:J1").Borders(xlEdgeTop).Weight = xlThin

x = 2 'Variable pour l'incrément

'************************************************Boucle de remplissage du nouveau fichier Excel****************************************************************

For i = 3 To DL_AFFRETEMENT

If Sheets("AFFRETEMENTS EN COURS").Range("A" & i) = Date Then

    xlBook.Sheets(1).Range("A" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("B" & i) 'Client
    xlBook.Sheets(1).Range("B" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("D" & i) 'Ville chrgmt
    xlBook.Sheets(1).Range("C" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("E" & i) 'Dpt chrgmt
    xlBook.Sheets(1).Range("D" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("F" & i) 'Ville livraison
    xlBook.Sheets(1).Range("E" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("G" & i) 'Dpt livraison
    xlBook.Sheets(1).Range("F" & x).Value = CDate(Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("I" & i)) 'Date chargement
    xlBook.Sheets(1).Range("G" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("P" & i) 'Affrété
    xlBook.Sheets(1).Range("H" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("K" & i) 'Prix client
    xlBook.Sheets(1).Range("H" & x).NumberFormat = "#,##0.00 €"
    xlBook.Sheets(1).Range("I" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("L" & i) 'Prix affrété
    xlBook.Sheets(1).Range("I" & x).NumberFormat = "#,##0.00 €"
    xlBook.Sheets(1).Range("J" & x).Value = Workbooks(Classeur_Actuel).Sheets("AFFRETEMENTS EN COURS").Range("M" & i) 'Marge
    xlBook.Sheets(1).Range("J" & x).NumberFormat = "#,##0.00 €"
    
       
    x = x + 1 'Incrémentation
       
End If

Next i

xlBook.Sheets(1).Columns("A:J").AutoFit


'**************************************************Tri et sauts de ligne pour isoler les clients + calcul des totaux + pourcentages**********************************************

DL_REPARTITION = xlBook.Sheets(1).Cells(Application.Rows.Count, 1).End(xlUp).Row


xlBook.Sheets(1).Range("A2:J" & DL_REPARTITION).Sort Key1:=xlBook.Sheets(1).Range("A2"), Order1:=xlAscending, Order2:=xlAscending 'Tri par client


Total = 0

TotalGeneral = 0


For i = 2 To DL_REPARTITION

If xlBook.Sheets(1).Range("A" & i).Value <> xlBook.Sheets(1).Range("A" & i + 1).Value Then

    compteur = compteur + 1
    
End If

Next i


For i = 2 To DL_REPARTITION + compteur

If xlBook.Sheets(1).Range("A" & i).Value = xlBook.Sheets(1).Range("A" & i + 1).Value Then

    Total = Total + xlBook.Sheets(1).Range("J" & i).Value

ElseIf xlBook.Sheets(1).Range("A" & i).Value <> xlBook.Sheets(1).Range("A" & i + 1).Value And xlBook.Sheets(1).Range("A" & i + 1).Value <> "" And xlBook.Sheets(1).Range("A" & i).Font.Bold = False Then

    xlBook.Sheets(1).Rows(i + 1).Insert
    
    xlBook.Sheets(1).Range("A" & i + 1).Value = "Total " & xlBook.Sheets(1).Range("A" & i).Value
    xlBook.Sheets(1).Range("A" & i + 1).Font.Bold = True
    xlBook.Sheets(1).Range("A" & i + 1 & ":J" & i + 1).HorizontalAlignment = xlCenterAcrossSelection
    xlBook.Sheets(1).Range("A" & i + 1 & ":J" & i + 1).Borders(xlEdgeTop).Weight = xlThin
    xlBook.Sheets(1).Range("A" & i + 1 & ":J" & i + 1).Borders(xlEdgeBottom).Weight = xlThin

    xlBook.Sheets(1).Range("J" & i + 1).Value = Total + xlBook.Sheets(1).Range("J" & i)
    xlBook.Sheets(1).Range("J" & i + 1).NumberFormat = "#,##0.00 €"
    xlBook.Sheets(1).Range("J" & i + 1).Font.Bold = True
    
    Total = 0
    
Else

    If xlBook.Sheets(1).Range("A" & i).Font.Bold = False Then

    xlBook.Sheets(1).Range("A" & i + 1).Value = "Total " & xlBook.Sheets(1).Range("A" & i).Value
    xlBook.Sheets(1).Range("A" & i + 1).Font.Bold = True
    xlBook.Sheets(1).Range("A" & i + 1 & ":J" & i + 1).HorizontalAlignment = xlCenterAcrossSelection
    xlBook.Sheets(1).Range("A" & i + 1 & ":J" & i + 1).Borders(xlEdgeTop).Weight = xlThin
    xlBook.Sheets(1).Range("A" & i + 1 & ":J" & i + 1).Borders(xlEdgeBottom).Weight = xlThin
    
    xlBook.Sheets(1).Range("J" & i + 1).Value = Total + xlBook.Sheets(1).Range("J" & i)
    xlBook.Sheets(1).Range("J" & i + 1).NumberFormat = "#,##0.00 €"
    xlBook.Sheets(1).Range("J" & i + 1).Font.Bold = True
    
    Total = 0
    
    End If
    
End If

Next i

DL_REPARTITION = xlBook.Sheets(1).Cells(Application.Rows.Count, 10).End(xlUp).Row

For i = 2 To DL_REPARTITION

If xlBook.Sheets(1).Range("J" & i).Font.Bold = True Then

    TotalGeneral = TotalGeneral + xlBook.Sheets(1).Range("J" & i).Value
    
End If

Next i

xlBook.Sheets(1).Range("A1:J1").Borders(xlEdgeBottom).Weight = xlMedium

xlBook.Sheets(1).Range("A" & DL_REPARTITION + 1).Value = "Total Général"
xlBook.Sheets(1).Range("A" & DL_REPARTITION + 1 & ":J" & DL_REPARTITION + 1).HorizontalAlignment = xlCenterAcrossSelection
xlBook.Sheets(1).Range("A" & DL_REPARTITION + 1).Font.Bold = True
xlBook.Sheets(1).Range("A" & DL_REPARTITION + 1 & ":J" & DL_REPARTITION + 1).Borders(xlEdgeTop).Weight = xlMedium


xlBook.Sheets(1).Range("J" & DL_REPARTITION + 1).Value = TotalGeneral
xlBook.Sheets(1).Range("J" & DL_REPARTITION + 1).NumberFormat = "#,##0.00 €"
xlBook.Sheets(1).Range("J" & DL_REPARTITION + 1).Font.Bold = True


For i = 2 To DL_REPARTITION

If xlBook.Sheets(1).Range("J" & i).Font.Bold = True Then
    
    With xlBook.Sheets(1).Range("K" & i)
    
        .Value = xlBook.Sheets(1).Range("J" & i).Value / TotalGeneral
        .NumberFormat = "#,##0.00 %"
        .Font.Italic = True
        
    End With
    
End If

Next i


'****************************************************************************Insertion d'un graphique de récap********************************************************************************

xlBook.Activate

compteur = 0

xlBook.Sheets(1).Range("J5").Select

For i = 2 To DL_REPARTITION

If xlBook.Sheets(1).Range("A" & i).Font.Bold = True And xlBook.Sheets(1).Range("A" & i).Value <> "Total Général" Then

    compteur = compteur + 1
    
    If compteur = 1 Then
    
        Application.Union(xlBook.Sheets(1).Range("A" & i), xlBook.Sheets(1).Range("K" & i)).Select
        
    Else
    
        Application.Union(Selection, xlBook.Sheets(1).Range("A" & i), xlBook.Sheets(1).Range("K" & i)).Select
        
    End If
    
End If

Next i



Set xlApp = Nothing
Set xlBook = Nothing

End Sub



J'ai une erreur sur les lignes Application.Union. "La méthode 'Union' de l'objet '_Application' a échoué". Je me suis dit que ça venait du fait de mettre un objet dans un objet.

Du coup j'ai tenté un truc du style : 

Nom_Classeur = xlBook.Name

Application.Union(Workbooks(Nom_Classeur).Sheets(1).Range("A" & i), Workbooks(Nom_Classeur).Sheets(1).Range("K" & i)).Select


Mais alors là j'ai l'erreur : "L'indice n'appartient pas à la sélection", je me demande comment c'est possible.......

Merci d'avance pour votre aide et votre courage pour lire cette tartine...

Cordialement.

4 réponses

Réponse 1 / 4
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
Re,

Ton fichier avec la macro revue et corrigée :
https://www.cjoint.com/c/FKcpo5jgDiY
1
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   62
 
Bonjour,

Effectivement ça fonctionne très bien !

Merci pour ton aide. Et merci de m'avoir appris pas mal de choses grâce aux changements sur mon code, notamment le fait de créer un objet pour la feuille de mon classeur initial, ce qui évite de répéter 15 fois la même chose.

Merci encore.

Cordialement.
0
Réponse 2 / 4
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
Bonjour,

Supprimes l'emploi des Select et tu n'aura plus de problème.
0
Réponse 3 / 4
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   62
 
Bonjour Patrice33740,

Merci pour ta réponse.

Le problème étant que j'ai besoin de sélectionner les cellules en question pour insérer un graphique ensuite.

Si tu regarde comment j'ai construis le code, à la première vérification, je sélectionne des cellules, ensuite, sur les vérifications suivantes, j'ajoute des cellules à ma sélection actuelle.

Sinon, comment je pourrais faire pour travailler directement sur le classeur qui m'intéresse? Car là je passe par un classeur initial qui créé mon classeur sur lequel je travaille. D'où le problème de sélection.

J'ai bien essayé un xlBook.Activate. Et ensuite, au lieu de 

Application.Union(xlBook.Sheets(1).Range("A" & i), xlBook.Sheets(1).Range("K" & i)).Select


J'écris : 

Application.Union(ActiveWorkbook.Sheets(1).Range("A" & i), ActiveWorkbook.Sheets(1).Range("K" & i)).Select


Et là, plus d'erreur dans le code. Oui sauf que les sélections se font sur le classeur initial d'où a été lancée la macro. Et non sur classeur xlBook...
0
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
Re, 

Dim r as Range
Set r = Application.Union(ActiveWorkbook.Sheets(1).Range("A" & i), _
                          ActiveWorkbook.Sheets(1).Range("K" & i))
r.select
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   62 > Patrice33740 Messages postés 8930 Statut Membre
 
Re,

Du coup j'ai écris : 

Set r = Application.Union(xlBook.Sheets(1).Range("A" & i), xlBook.Sheets(1).Range("K" & i))


Même message d'erreur "La méthode 'Union' de l'objet '_Application' a échoué"..
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   62 > Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention  
 
Microsoft dit :

Visual Basic a défini une référence à Excel en raison d'une ligne de code qui appelle un objet, une méthode ou une propriété Excel sans qualifier cet élément avec une variable objet Excel. Visual Basic ne libère pas cette référence tant que vous ne quittez pas le programme. Cette référence dévoyée interfère avec un code Automation si le code est exécuté plusieurs fois.
0
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
Re,

En écrivant quelque chose comme : 
Dim r as Range

  With xlBook.Worksheets(1)
    compteur = 0
    Set r = Nothing
    For i = 2 To DL_REPARTITION
      If .Range("A" & i).Font.Bold = True And _
         .Range("A" & i).Value <> "Total Général" Then
        Set r = Application.Union(r, .Sheets(1).Range("A" & i), _
                                  .Sheets(1).Range("K" & i))
      End If
    Next i
  End With
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   62 > Patrice33740 Messages postés 8930 Statut Membre
 
"Propriété ou méthode non gérée par cet objet" sur la ligne :

Set r = Application.Union(r, .Sheets(1).Range("A" & i), _
.Sheets(1).Range("K" & i))

Est-ce que ce serait parce qu'initialement r = Nothing donc il ne comprend pas comment avoir un Union sur nothing?
0
Réponse 4 / 4
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
C'est normal, il faut sélectionner r si c'est indispensable (ce qui est rarement le cas !), essaies : 
Dim r As Range

  With xlBook.Worksheets(1)
    compteur = 0
    Set r = Nothing
    For i = 2 To DL_REPARTITION
      If .Range("A" & i).Font.Bold = True And _
         .Range("A" & i).Value <> "Total Général" Then
        Set r = Application.Union(r, .Range("A" & i), _
                                  .Range("K" & i))
      End If
    Next i
    r.Select  'pour selectionner r si c'est nécessaire !!!
  End With
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   62
 
"Argument ou appel de procédure incorrect" sur la ligne : 

Set r = Application.Union(r, .Range("A" & i), _
                                  .Range("K" & i))


en faisant un copier/coller de ton code.
0
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
Poste ton fichier sur cjoint.
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   62 > Patrice33740 Messages postés 8930 Statut Membre
 
Re,

Voici le fichier https://www.cjoint.com/c/FKcoaog7yTf

Il ne faut pas oublier de changer le chemin d'enregistrement du fichier généré.

Merci encore pour ton aide.

En attendant, je vais faire un tableau provisoire pour générer mon graphique sans utiliser la fonction Union.
0