Ouverture de fichier Excel impossible

Le 19/07/2017 à 14:12

Bonjour à toi qui li ce poste,

J'ai un problème avec une macro excel qui teste pour savoir si un fichier excel et ouvert et l'ouvre si il ne l'est pas. Enfin c'est le but ^^

Private Function EstDansCollection(Coln As Object, Item As String) As Boolean
Dim obj As Object
On Error Resume Next
Set obj = Coln(Item)
EstDansCollection = Not obj Is Nothing
End Function

Private Sub CommandButton1_Click()
Dim Reponse
    If EstDansCollection(Workbooks, "Analyse Statistique Devis.xlsx") = True Then
        MsgBox "Le classeur est déjà ouvert !"
    Exit Sub
End If

If EstDansCollection(Workbooks, "Analyse Statistique Devis.xlsx") = False Then
    Reponse = MsgBox("Le classeur n'est pas ouvert, voulez-vous l'ouvrir ?", vbInformation + vbYesNo)
    If (Reponse = vbNo) Then
    Exit Sub
Else
        Workbooks.Open Filename:="Q:\Chiffrage\Outils de chiffrage\analyse statistique\" & "Analyse_Statistique_Devis" & ".xlsx"
    End If
End If
End Sub

La ligne qui pose problème est la dernière :

Workbooks.Open Filename:="Q:\Chiffrage\Outils de chiffrage\analyse statistique\" & "Analyse_Statistique_Devis" & ".xlsx"

Un message excel apparait est me dit

"Nous Sommes désolés, mais "Q:\Chiffrage\Outils de chiffrage\analyse statistique\Analyse_Statistique_Devis.xlsx" est introuvable. Peut-être a-t-il été déplacé, renommé ou supprimé ?"

Mais le fichier existe bien avec le bon nom et le bon chemin.

Si quelqu'un peut m'aider

Le 19/07/2017 à 14:27

bonjour

tu te compliques la vie. Un simple lien hypertexte (ou la fonction LIENHYPERTEXTE() ) suffit.

Le 19/07/2017 à 14:32

Ah oui je sais mais c'est une petite partie d'un code pour exporter des lignes d'un tableau source vers le ficher à ouvrir donc je suis partie sur du VBA.

voila le code de départ que je voudrais modifier pour ne pas avoir a aller chercher le fichier destination à chaque lancement de macro

Sub export()

Dim wbMyWb As Workbook
Dim Nom_Fichier As Variant
Dim Verification As Boolean
Dim MonClasseur As String

'On cherche la derniere ligne avec un numéros de devis valide
x = 14
Numdevis = Cells(x, 1).Value
    While Numdevis < 200
        x = x - 1
        Numdevis = Cells(x, 1).Value
    Wend

'On copie de la 2éme ligne à la dernière ligne valide
Sheets("Stat").Activate
Range(Cells(2, 1), Cells(x, 13)).Select
Selection.Copy

'On ouvre le fichier de destination de la copie
Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xls")
    If Nom_Fichier <> False Then
        Set wbMyWb = Workbooks.Open(Nom_Fichier)
        wbMyWb.Activate
    End If

'On colle en valeurs la selection copiée à partir de la dernière ligne vide du tableau
Sheets("Devis statistique").Activate
Sheets("Devis statistique").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
nbLignes = Sheets("Devis statistique").Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:M" & nbLignes).Borders(xlEdgeBottom).Color = RGB(0, 0, 0)

'On sauvegarde
wbMyWb.Save

End Sub
Le 19/07/2017 à 15:32

re

alors n'"exporte" pas. Il est d'ailleurs déconseillé d'exporter d'un classeur à un autre.

il suffit de créer des liaisons entre classeurs.

aucune formule, aucun VBA.

aucun besoin d'ouvrir le classeur des données une fois que les liaisons sont établies

Le 19/07/2017 à 15:43

mais si le fichier destination et relié à une centaines d'autres fichiers "source", ça vas pas créer des problèmes ?

Le 20/07/2017 à 07:58

re

aucune idée, essaye avec 10 puis 20...

mais personne n'a 100 fichiers à exploiter en même temps !

mon avis : ce sont des exports, donc voir le script d'export pour exporter TOUTE la base d'un coup et non des bribes chaque mois.

tu peux aussi voir PowerPivot si les données sont relationnelles

Le 21/07/2017 à 08:26

Merci pour vos réponses, j'ai réussie a faire un truc qui marche bien donc je le laisse ici si ça peut aider quelqu'un un jour ^^

Private Function EstDansCollection(Coln As Object, Item As String) As Boolean
Dim obj As Object
On Error Resume Next
Set obj = Coln(Item)
EstDansCollection = Not obj Is Nothing
End Function

Sub export()

Dim wbMyWb As Workbook
Dim Nom_Fichier As Variant
Dim Reponse

Workbooks("Synthèse.xlsm").Activate
'On cherche la derniere ligne avec un numéros de devis valide
x = 14
Numdevis = Cells(x, 1).Value
    While Numdevis < 200
        x = x - 1
        Numdevis = Cells(x, 1).Value
    Wend

'On copie de la 2éme ligne à la dernière ligne valide
Sheets("Stat").Activate
Range(Cells(2, 1), Cells(x, 13)).Select
Selection.Copy

'On teste pour savoir si le fichier de destination est ouvert ou fermé
If EstDansCollection(Workbooks, "Analyse Statistique.xlsx") = True Then
    MsgBox "Le classeur est déjà ouvert !"
    GoTo Coller
Else
'Si non, on l'ouvre (ou pas)
    Reponse = MsgBox("Le classeur n'est pas ouvert, voulez-vous l'ouvrir ?", vbInformation + vbYesNo)
    If (Reponse = vbNo) Then
        Exit Sub
    Else
        Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xls")
        If Nom_Fichier <> False Then
            Set wbMyWb = Workbooks.Open(Nom_Fichier)
            wbMyWb.Activate
        End If
    End If
End If

Coller:
'On colle en valeurs la selection copiée à partir de la dernière ligne vide du tableau
Workbooks("Analyse Statistique.xlsx").Activate
Sheets("Statistique").Activate
Sheets("Statistique").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
nbLignes = Sheets("Statistique").Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:M" & nbLignes).Borders(xlEdgeBottom).Color = RGB(0, 0, 0)

'On sauvegarde
Workbooks("Analyse Statistique.xlsx").Save

End Sub

Bonne fin de soirée.

et manger du chocolat !!

Rechercher des sujets similaires à "ouverture fichier impossible"