Problème sur Application.Union

Le 02/11/2016 à 13:47

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.

Le 03/11/2016 à 08:03

Bonjour,

Il n'y a pas de raison que ça ne fonctionne pas. Juste une chose m'intrigue, c'est cette ligne de code :

Nom_Classeur = xlBook.Name

Est-ce une nouvelle commande des versions ultérieure à 2007 ?

Avec ceci ça fonctionne :

Sub Test()

    Dim Nom_Classeur As String
    Dim I As Integer

    Nom_Classeur = ThisWorkbook.Name

    I = 5

    With Workbooks(Nom_Classeur).Sheets(1)

        Application.Union(.Range("A" & I), .Range("K" & I)).Select

    End With

End Sub
Le 03/11/2016 à 08:52

Bonjour,

Si on crée un nouveau classeur dans une nouvelle instance d'Excel, ce qui n'avait rien de nécessaire ! le classeur pouvait fort bien être créé dans la même instance que le classeur origine, il est mieux de savoir ce que l'on fait et de tenir compte qu'on est en présence de 2 Excel !

Le cas échéant, Union sans qualificateur explicite pourra fonctionner. Sinon : xlApp.Application....

Cordialement.

Rechercher des sujets similaires à "probleme application union"