Résultats pour "fichier introuvable"

4'083 résultats pour cette recherche

Bonjour à toutes et à tous, j'ai un problème.

J'écris une macro qui a pour but d'extraire des données dans un fichier excel source pour les importer dans un fichier excel de destination, mon fichier de travail. Cependant Lorsque je lance ma macro, j'ai le message "Erreur d'exécution '1004': 'Fichiersource.xlsx' introuvable. Vérifiez l'orthographe du nom du classeur et la validité de l'emplacement." alors que le fichier est bel et bien là, en bonne et due forme.

Voici mon code :

Sub macro1()

Dim CD As Workbook

Dim OD As Worksheet

Dim CA As String

Dim CS As Workbook

Dim OS As Worksheet

Dim Fichier As String

Dim DL As Range

Application.ScreenUpdating = False

Set CD = ThisWorkbook

Set OD = CD.Sheets("Ongletdestination")

CA = CD.Path

Fichier = Dir(CA & "\Fichiersource.xlsx")

Application.Workbooks.Open (Fichier) (C'est ici que mon problème se manifeste)

Set CS = ActiveWorkbook

Set OS = CS.Sheets("Ongletsource")

DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)

OS.Range(A, L).Copy

DL.PasteSpecial (xlPasteValuesAndNumberFormats)

CS.Close savechanges = False

Application.ScreenUpdating = True

MsgBox "Importation reussie"

End Sub

Quelqu'un pourrait m'aider s'il vous plait ?

Bonjour le forum, et merci pour toute l'aide que vous m'avez déjà apporté via différents topics !

J'aurais besoin de votre aide aujourd'hui.

J'ai dans mon formulaire de BDD, une page (du multipages) qui permet de modifier les informations d'un objet. Pour cela j'ai réalisé une TextBox où l'on tape l'ID de l'objet et au clic du bouton rechercher, les différentes informations apparaissent dans des TextBox et Combobox prévu pour.

Chaque objet à sa photo pour bien l'identifier. Pour modifier la photo de l'objet, j'ai créé un bouton qui au clic, ouvre un explorateur de fichier, ce qui permet à l'utilisateur de choisir sa photo. Dès que l'utilisateur à choisi la photo adéquate, le code modifie son nom en fonction de ses informations (ID + Localisation) puis la place dans le fichier correspondant. Le chemin du fichier de la photo dans son dossier final apparaît ensuite dans une TextBox sur le formulaire.

Le code de ce bouton est bon car je l'utilise pour la création de la fiche de l'objet et tout fonctionne à merveille. Le problème vient du fait que je recherche les informations de l'objet et les insères dans les TextBox. En faisant des MsgBox, je m'aperçois que l'AncienNom et le NouveauNom sont correct ! Pourtant je reçois un message d'erreur 53 point la ligne "Name AncienNomDeux As NouveauNomDeux".

Code du bouton ouvrant l'explorateur de fichier

Private Sub CommandButton_Tof2_Click()

    'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim AncienNomDeux As Variant
    Dim NouveauNomDeux As Variant

    'Si la localisation ou l'ID de l'objet n'est pas indiqué, alors on indique un message
    If ComboBox_loc = "" Then

        MsgBox ("Vous devez renseigner la localisation de l'objet.")

    ElseIf TextBox_ID = "" Then

         MsgBox ("Vous devez renseigner l'ID de l'objet.")

    Else

        'On ouvre l'explorateur de fichiers et on met le lien du document choisi dans la Textbox_lienDoc
        Application.FileDialog(msoFileDialogFilePicker).Title = "Choisissez un fichier !"
        Application.FileDialog(msoFileDialogFilePicker).InitialFileName = "\XX\XX\XXX"
        Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = False

        If Application.FileDialog(msoFileDialogFilePicker).Show = -1 Then

            AncienNomDeux = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
            NouveauNomDeux = "XX\XX\XXXX\" & ComboBox_loc & "\" & ComboBox_loc & "_" & TextBox_ID.Value & ".jpg"

            'Vérifie si le fichier à renommer existe.
            If Dir(AncienNomDeux) = "" Then Exit Sub
'            MsgBox (NouveauNomDeux & "    " & AncienNomDeux)

            'Renomme le fichier
            Name AncienNomDeux As NouveauNomDeux

            TextBox_LienPhoto2 = NouveauNomDeux

        End If

    End If

    'On met le focus sur le bouton valider
    CommandButton_sauvegarder.SetFocus

    'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Quel est mon soucis ?

Merci d'avance !

Bonjour la communauté,

Essayant de développer un programme de réservation de chambre d’hôtel en compagnie d'un ami, nous nous retruvons confronté à un message d'erreur "erreur d'exécution 53" - Fichier introuvable user64.

il travaille à distance avec une version 32b et moi 64b alors le problème est peut être là.

Comment puis je régler ce problème d’affichage du calendrier ?

Merci pour votre aide toujours précieuse

18hotel-new-5.xlsm (117.88 Ko)

Bonjour à tous;

Une nouvelle fois j aurais besoin de vos précieuses lumières...

Voila j'enregistre mes différents documents sur un nas, et nous ouvrons les documents depuis un MAC et un PC

Depuis quelque jours j'arrive à ouvrir les documents depuis mon MAC, mais lorsque j'essaie d'ouvrir depuis le PC j'ai un message "Le fichier est introuvable"

Je précise que cela ce fait avec certains fichiers, pas tous...

Et que les fichiers sont trouvables et tout a fait lisible sur MAC et pas sur PC....

Merci d'avoir prit le temps de me lire...

Macachou

Bonsoir

Pouvez-vous svp m'aider à résoudre mon problème ?

Après avoir travaillé sur un fichier Excel, je n'ai pu enregistrer le fichier (avec un message m'indiquant que le fichier ne pouvait être enregistré et qu'un nouveau fichier était créé). A la place j'ai eu un fichier intitulé CC8D7830 que j'ai eu à renommer pour pouvoir l'ouvrir (comme indiqué). Or, je n'arrive pas à l'ouvrir avec excel. Donc pour l'instant j'ai virtuellement perdu mon travail.

Y a t'il un moyen pour que ce fichier puisse s'ouvrir avec Excel ?

En remerciant les personnes qui pourront m'aider.

Dordanche

bonjour,

je sollicite vos compétences, car j'ai mis des boutons dans mon classeur ebauche_organisation et je voudrais que ceux ci ouvrent chacun un classeur différents soit 5 classeurs au total.

j'ai mis une macro mais elle ne fonctionne pas ça me donne une erreur 1004 fichier introuvable.

merci d'avance

cordialement

Bonjour,

le but de cette macro est de récupérer chaque fichier *.xlxm dans le répertoire MAR, d'effectuer quelques modifications dessus et de l'enregistrer dans un autre répertoire FAB en *.xlsx.

Cela marche de temps en temps et parfois j'ai ce message :

Erreur n°1004 - Fichier introuvable. Vérifiez l'orthographe du nom du classeur et la validité de l'emplacement.

Or mes fichiers se trouvent bien à l'emplacement indiqué. et le débogage m'envoie sur la ligne suivante :

Workbooks.Open Filename:=CheminMAR & Fichier

Sub Pour_FAB()
Dim CheminMAR As String
Dim CheminFAB As String
Dim Fichier As String
Dim i As Long
Dim S As Integer

Application.DisplayAlerts = False
CheminMAR = ThisWorkbook.Path & "\MAR\"
CheminFAB = ThisWorkbook.Path & "\FAB\"
If Dir(CheminFAB, 16) = "" Then MkDir CheminFAB
Fichier = Dir(CheminMAR & "*.xlsm")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Fichier <> ""
For i = 1 To Sheets.Count
Workbooks.Open Filename:=CheminMAR & Fichier
'Suppression des lignes en trop
For S = 4 To Sheets.Count 'à partir de la 4e feuille
ActiveWorkbook.Sheets(S).Select 'Sélectionner toutes les feuilles
Rows(1).EntireRow.Delete Shift:=xlUp
Rows(2).EntireRow.Delete Shift:=xlUp
Next S

Sheets(Array("Index", "GAB_1", "GAB_2")).Select
Sheets("GAB_2").Activate
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Import_DATA")
newname = Replace(ActiveWorkbook.Name, ".xlsm", "")
ActiveWorkbook.SaveAs Filename:=CheminFAB & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False  'renommer
ActiveWorkbook.Close
Fichier = Dir
Next i
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit
End Sub

En fait cela plante au dernier classeur.

Quelqu'un aurait il une idée ?

Bonne journée à tous

Bonjour,

Je suppose que mon problème est déjà arrivé car j'utilise la version Excel 2000 mais je n'ai pas trouvé le sujet avec la solution dans les nombreuses pages qui traitent de cette "erreur d'exécution 1004".

J'espère que vous pourrez m'aider avec ma première macro qui fonctionne bien si on laisse de côté ce message d'erreur...

L'idée initiale était de faire un tableau récapitulatif de plusieurs classeurs excel.

Tout se passe bien jusqu'à ce que je ferme et que je ré ouvre Excel. Dès lors, en lançant la macro, le message d'erreur "erreur d'exécution 1004 "untel.xls" introuvable " apparait en m'indiquant le nom du premier fichier qui doit être pris en compte alors que moi, dans la macro, j'ai indiqué "*.xls" : Donc pourquoi, ça me dit que le fichier est introuvable si son nom a été trouvé?

J'ai changé le niveau de sécurité (Outils _ macro _ sécurité) en le mettant au plus bas pour savoir si c'était ça, mais ça ne fonctionne toujours pas.

Pour déboguer, j'arrête la macro, en enregistre une nouvelle dans laquelle je refais le chemin d'accès à un des fichiers que je veux synthétiser. Je copie-colle ce chemin d'accès dans la macro initiale (ce qui est collé correspond exactement à ce qui était indiqué précédemment).

Je clique F5, et tout fonctionne. Alors que fondamentalement, rien n'a changé.

J'ai mis en fichier joint l'endroit surligné par le débogage. En bleu, le chemin d'accès concerné (les noms des fichiers sont en ".xlsx.xls" car je n'ai pas trouvé dans cette version d'excel la possibilité de changer le .xls en .xlsx et comme le tableau récapitulatif est dans le même fichier, il m'a semblé qu'il fallait une différence pour que la macro sache quel fichier prendre en compte ou non).

Est-ce un problème de configuration qui bloque les macros? mais j'ai pas trouvé où ça pouvait se changer.

Voilà, j'espère que le souci n'est pas grave,

Et vous remercie

Bonjour à tous

J'ai depuis peu un message d'erreur "projet ou bibliothèque introuvable" sur un de mes classeurs

Ce classeur est en .xlsm alors qu'il ne contient pas de macro

J'ai essayé de l'enregistrer en .xlsx mais cela ne fonctionne pas

J'ai essayé VBA > Outils > Références mais rien ne se passe quand je clique dessus.

Savez vous d'où cela peut il venir?

Un grand merci pour votre aide

Bonjour à tous,

J'ai un message d'erreur que je n'arrive pas à résoudre.

Le premier userform à ouvrir est le userform4. J'aimerais que lorsque l'on entre un nombre de colonne et que l'on valide, le userform1 s'ouvre et laisse uniquement le même nombre de textbox que le nombre entré précédemment.

Le problème c'est que lorsque le userform1 s'initialise, un message d'erreur apparait. (Objet spécifié introuvable).

Pour le moment j'ai que 2 petits morceaux de code, un dans :

Module1/userform1/userform_initialize()

Private Sub UserForm_initialize()
Dim i As Variant
Dim toto As Variant
toto = UserForm4.TextBox3.Value + 1
For i = toto To 18
Controls("Textbox" & i).Visible = False
Next i
End Sub

Et l'autre dans

Module1/Userform4/CommandButton3_Click()

Private Sub CommandButton3_Click()

UserForm1.Show

End Sub

Voilà, j'espère avoir été clair. Si quelqu'un arrive à me dépanner ce serait super. N'hésitez pas si vous voulez plus d'indications.

Bien entendu je joins le fichier.

3classeur1.xlsm (24.25 Ko)

Bonjour,

Je me permets de vous solliciter car cela fait plusieurs heures que je cherche et je ne parviens pas à trouver ce qui bloque avec mon code.

Contexte : je veux créer un fichier pour mon boulot qui me permette de trouver le prix d'articles (en l’occurrence cylindre ou clé) en fonction de certaines informations saisie par l'utilisateur sur une feuille Excel.

Problème : quand mon code s'exécute (à chaque modification de ma feuille), il tourne sans s'arrêter et plante mon fichier.

Voici mon code (onglet "Find a price") :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

'Let's calculate these prices :)

'But first, let's go for some explanations of my code :

'*** Named cells ***
'
'I named all of the user cells to allow me to use the name in my vba code.
'Okay but why?
'=> because if I decide to change the design of my user form sheet, I wouldn't have to update the cells adress in my code
'Indeed if I use named cells, I can change their adress without have to update the code!
'
'All the cells in the sheet "find a price" are like "fp_XXX"
'All the cells in the sheet "Make a quote" are like "mq_XXX"
'All the cells in the sheet "Source data" are like "sd_XXX"
'
'"c" will always means column and "r" row.

'*** Structure of this code ***
'
'First, I will calculate all the different elements (and potential added value) which constitute the price of the cylinders/keys
'And then, I will finally calculate these prices

'Base price of the cylinder
Dim base_cyl_price As Currency

    'Each cylinder has a base price depending on which profile and which cylinder type it is
    base_cyl_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_cyl_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_cyl_type"), Worksheets("Src_data").Range("sd_cyl_types"), 0))
    'We will add in the final formula the value of the potential extensions and other added values

'Extension price
Dim extension_price As Currency
Dim extension_nbr As Byte

    'We will determine how many extensions there are
    extension_nbr = Application.VLookup((Worksheets("Find a price").Range("fp_ins_length") & Worksheets("Find a price").Range("fp_out_length")), Worksheets("Extensions").Range("tble_extensions"), 2, False)

    'And then get the price of all these potential extensions
    If extension_nbr <= 10 Then
        extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_1")
    Else
        extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_2")
    End If

'Base price of the key
Dim base_key_price As Currency

    'If the client wants a supplementary key with a cylinder, no matter if the plan is 6 months older or no, in the other cases, we first check this point
    If Worksheets("Find a price").Range("fp_key_type") = "Supplementary key with cylinder" Then
        base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), 1)
    Else
        If Worksheets("Find a price").Range("fp_ext_6_yn") = "No" Then
            base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_key_type"), Worksheets("Src_data").Range("sd_key_types"), 0))
        Else
            base_key_price = Worksheets("Src_data").Range("sd_key_price_6")
        End If
    End If

'Discount rate
Dim discount_rate As Variant

    'We just take the rate input by the user
    discount_rate = Worksheets("Find a price").Range("fp_discount_rate")

'Potential added value for the pins
Dim adval_pin As Currency

    'We just add the potential added value if the client wants a 6 or 7 pins system
    If Worksheets("Find a price").Range("fp_pin") = 6 Then
        adval_pin = Worksheets("Src_data").Range("sd_adval_6pins")
    Else
        If Worksheets("Find a price").Range("fp_pin") = 7 Then
            adval_pin = Worksheets("Src_data").Range("sd_adval_7pins")
        Else
            adval_pin = 0
        End If
    End If

'Potential added value for the system
Dim adval_system As Currency

    'We just add the added value for HS systems or GHS ones
    If Worksheets("Find a price").Range("fp_system") = "HS" Then
        adval_system = Worksheets("Src_data").Range("sd_adval_HS")
    Else
        If Worksheets("Find a price").Range("fp_system") = "GHS" Then
            adval_system = Worksheets("Src_data").Range("sd_adval_GHS")
        Else
            adval_system = 0
        End If
    End If

'Potential added value if keyplan extension
Dim adval_not_init As Currency
Dim adval_6months As Currency

    'We add the FHZ if the client is not the initiator of the keyplan (22% added-value)
    If Worksheets("Find a price").Range("fp_ext_init_yn") = "No" Then
        adval_not_init = Worksheets("Src_data").Range("sd_adval_not_init")
    Else
        adval_not_init = 0
    End If

    'We add the old system added-value of 7.98€ if the keyplan is 6 months old or more
    If Worksheets("Find a price").Range("fp_ext_6_yn") = "Yes" Then
        adval_6months = Worksheets("Src_data").Range("sd_adval_6months")
    Else
        adval_6months = 0
    End If

'Potential added value for the finishes
Dim adval_finishes As Currency

    'To do...

'Potential added value for the knob
Dim adval_knob As Currency

    'To do...

'Let's now calculate the price of the cylinder :)
Dim cylinder_price As Currency

    'This is the final formula to calculate the cylinder price, we will just sum up all the things we previously calculated above ;)
    cylinder_price = (base_cyl_price + extension_price + adval_pin + adval_system + adval_6months) * (1 + adval_not_init) * (1 - discount_rate)
    Worksheets("Find a price").Range("fp_cyl_price") = cylinder_price

'And let's now calculate the price of the key :)
Dim key_price As Currency

    'And this is the same for the keys (in more easy)
    key_price = base_key_price * (1 + adval_not_init) * (1 - discount_rate)
    Worksheets("Find a price").Range("fp_key_price") = key_price

End Sub

Ainsi que mon fichier (rien n'est confidentiel) :

56tarifs-2020-v14.xlsm (556.03 Ko)

Si quelqu'un trouve une solution.. Je prends!

Vip4rk

Bonjour,

Je n'arrive pas à récupérer le n° de ligne correspondant à ma Target.

L'objet Target.Row semble introuvable mais je ne comprend pas bien pourquoi?

Le Fichier test ci-joint reprend le code suivant :

Sub test()
derln = Sheets("Feuil1").Range("D" & Rows.Count).End(xlUp)(1).Row
plage = Range("D2:D" & derln)
    If Range("A1") = "test" Then
        For Each Target In plage
            If Right(Target, 3) = "(2)" Then
                Range("A2").Value = Target.Row
                'Target.EntireRow.Insert Shift:=xlDown
            End If
        Next
    End If
End Sub

Merci d'avance pour votre aide

2test.xlsm (14.79 Ko)

Bonjour à tous,

Je souhaiterais afficher un message d'erreur "N° DP introuvable" dans le cas ou la valeur indiquée dans la cellule C1 de la feuille (ETIQUETTES EXPE) n'est pas présente dans le tableau (A$2:A).

1 macros a été réalisée, elle est liée au bouton (FILTRER DP)

Je souhaiterais associer cette fonctionnalité à la macro "Filtrer_DP_Etiquettes_Expe" qui permet de filtrer les données dans le tableau en fonction de 2 critères

Lors d'un clic sur le bouton FILTRER DP, il faudrait afficher un message d'erreur si la "DP N°24" dans cette exemple n'est pas présente dans la colonne (A$2:A)

Auriez-vous une idée ?

Merci

Fabien

Bonjour, j'ai eu la mauvaise idée de vouloir faire ménage sur mon disque dur et j'ai désinstallé office XP vu qu je suis passé à office 2010 depuis quelque temps.

Manque de bol, une des macros que j'utilise régulièrement ne fonctionne plus.

J'ai le message écrit dans le sujet qui apparaît lorsque je la lance.

Je vous met en copie la partie mise en surbrillance:

'recopie la ligne de "transfert" vers "année d'archive" en incrémentant d'une ligne à chaque opération'

Sheets("Transfert").Select

Rows("1:1").Select

Selection.Copy

Dim caisse

c = 0

Sheets("encours").Select

Selection1 = Range("A1:A100")

For Each caisse In Selection1

If caisse = VIDE Then

Rows(1 + c).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Exit For

End If

c = c + 1

Next caisse

Range("A2").Select

Sheets("Transfert").Select

Application.CutCopyMode = False

Sheets("Stock").Select

ActiveWorkbook.Save

End Sub

N’étant pas du tout familier du code VBA , je suis un peu perdu.

Merci d'avance pour votre aide .

Bonjour le forum

J'ai creer une application sur excel 2016, windows 10, tout marche sur l'ordinateur d'origine mais j'essai de la lancer sur un autre ordinateur (excel 2010, windows 7) et j'ai le message "bibliotheque introuvable" avec surligné "PreniousValue" et "Format(Now,"ddd;mm;yy").

Possible de m'aider?

Bonjour,

Je travaille sur un fichier excel avec des macro et tout ça

Sur mon PC, ça marche bien et tout mais si je mets mon fichier sur le réseau d'entreprise et que je le fait tourner sur un autre pc, il me mettre une erreur du type compilation impossible Projet ou bibliothèque introuvable.

Je comprends pas d'ou vient le problème, quelqu'un pour m’éclaircir le problème et comment le résoudre?

Cordialement,

Bonjour à tous,

J'ai une erreur de bibliothèque introuvable sur ma macro, j'ai essayer d'aller dans réferences, j'ai même ajouter une dll de excel 2003, la compilation ne se fait toujours pas.

Si quelqu'un aurait des lumières la dessus.

Encore merci

14liste-de-points.zip (100.99 Ko)

Bonjour,

Lors de l'ouvertude ce matin de mon classeur Excel, lorsque j'essai d'accéder à VBA, il me donne ce message d'erreur : "Projet ou bibliothèque introuvable".

Comment puis-je faire pour récupérer ce classeur avec mes macro svp ?

Merci d'avance

Obeïda

13cl-template-new.xlsm (116.22 Ko)

Bonsoir a tous,

J'essaye de mettre au point ce code sans y parvenir.

J'ai sur mon disque G le chemin suivant : G:\service A\Commerce \Dossiers

Par le biais d'un Userbox je renseigne dans ma feuille active les cellules X1, X2 et X3

si X1 n'existe pas il est créer Jusque la pas de soucis la création est réalisée.

Si X2 n'existe pas ce qui est le cas, j'obtiens le message: chemin d’accès introuvable et mon sous dossier n'est pas créer

Ci dessous ce que j'ai écris

Auriez vous une idée sur mon erreur

Merci a tous

Sub Enregistrement_sous_du_Fichier_Etude_Contrat()

Dim Activite As String

Dim Client As String

Dim Nom_Fichier_Etude As String

Dim Chemin As String

Activite = Range("X1").Value '''''''''''''''''''Nom du Dossiers activité

Client = Range("X2").Value '''''''''''''''''''Nom du Dossiers Client

Nom_Fichier_Etude = Range("X3").Value '''''''''''''''''''Nom du fichier pour enregistrer le classeur

Chemin = "G:\Service A\Commerce \Dossiers"

Activite = Chemin & "\" & Sheets("Détail Déboursés").Range("X1")

If Dir(Activite, vbDirectory) = "" Then MkDir Activite

Client = Activite & "\" & Sheets("Détail Déboursés").Range("X2")

If Dir(Client, vbDirectory) = "" Then MkDir Client

ActiveWorkbook.SaveAs Filename:=Client & "\" & Nom_Fichier_Etude & ".xlsm"

End Sub

Bonjour,

Je travaille actuellement sur un gros fichier dont la fonction n'a pas d'importance ici, et lorsque je l'ouvre, il m'indique qu'il y a une liaison (vers une version précédente du même doc) qu'excel ne peut pas reconstituer. Je sais pourquoi (l'ancienne version a été déplacée dans un dossier "old"), et comme je ne veux pas la conserver je voudrais la localiser pour mettre à jour la cellule.

Problème, impossible de trouver la liaison. J'ai essayé plusieurs méthodes :

1. ctrl+F dans l'ensemble du workbook en cherchant une séquence de caractère improbable issue du nom du fichier vers lequel renvoie la liaison

2. ctrl+F avec l'ensemble du nom du fichier

3. crtl+F avec le nom et l'adresse du fichier

4. Ctrl+H pour remplacer tous les "=" par rien pour faire sauter toutes les formules et refaire une recherche (même si avec les options avancées du ctrl+F j'aurais dû tomber dessus...)

5. Macro pour remonter les liaisons (j'ai utilisé deux macros, je les mets-ci dessous).

6. Balayer manuellement toutes les cellules des sections dans lesquelles j'ai avancé pour voir si je tombe sur la liaison

J'ai malheureusement beaucoup trop avancé pour pouvoir recommencer sur une version antérieure, et le fichier est bien trop complexe pour faire des copier-coller sauvage afin de trouver la liaison...

Si quelqu'un ici a un conseil ou une solution, j'offre mon éternelle reconnaissance, parce que je suis à deux doigts de brûler tout l'étage...

Ah, et je ne partage pas le fichier car c'est du confidentiel

Macro 1 : pour trouver les liens dans le workbook et les afficher dans une feuille créée à cet effet. Cette macro trouve effectivement un lien.

Sub links()
'Updateby20140529
Dim wb As Workbook
Set wb = Application.ActiveWorkbook

If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    wb.Sheets.Add
    xIndex = 1
    For Each Link In wb.LinkSources(xlExcelLinks)
        Application.ActiveSheet.Cells(xIndex, 1).Value = Link
        'Application.ActiveSheet.Cells(xIndex, 2).Value = link.Address
        Debug.Print Link
        xIndex = xIndex + 1
    Next Link
End If

End Sub

Macro 2 qui devrait me donner l'adresse de la cellule qui contient la liaison. Mais elle ne me retourne rien...

Sub listLinks()
    alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(alinks) Then
        Sheets.Add
        shtName = ActiveSheet.Name
        Set summaryWS = ActiveWorkbook.Worksheets(shtName)
        summaryWS.Range("A1") = "Worksheet"
        summaryWS.Range("B1") = "Cell"
        summaryWS.Range("C1") = "Formula"
        summaryWS.Range("D1") = "Workbook"
        summaryWS.Range("E1") = "Link Status"
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> summaryWS.Name Then
                For Each rng In ws.UsedRange
                    If rng.HasFormula Then
                        For j = LBound(alinks) To UBound(alinks)
                            filePath = alinks(j)   'LinkSrouces returns full file path with file name
                            Filename = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))   'extract just the file name
                            filePath2 = Left(alinks(j), InStrRev(alinks(j), "\")) & "[" & Filename & "]"  'file path with brackets

                            If InStr(rng.Formula, filePath) Or InStr(rng.Formula, filePath2) Then
                                nextrow = summaryWS.Range("A" & Rows.count).End(xlUp).Row + 1
                                summaryWS.Range("A" & nextrow) = ws.Name
                                summaryWS.Range("B" & nextrow) = Replace(rng.Address, "$", "")
                                summaryWS.Hyperlinks.Add Anchor:=summaryWS.Range("B" & nextrow), Address:="", SubAddress:="'" & ws.Name & "'!" & rng.Address
                                summaryWS.Range("C" & nextrow) = "'" & rng.Formula
                                summaryWS.Range("D" & nextrow) = filePath
                                summaryWS.Range("E" & nextrow) = linkStatusDescr(ActiveWorkbook.LinkInfo(CStr(filePath), xlLinkInfoStatus))
                                Exit For
                            End If
                        Next j

                        For Each namedRng In Names
                            If InStr(rng.Formula, namedRng.Name) Then
                                filePath = Replace(Split(Right(namedRng.RefersTo, Len(namedRng.RefersTo) - 2), "]")(0), "[", "") 'remove =' and range in the file path
                                nextrow = summaryWS.Range("A" & Rows.count).End(xlUp).Row + 1
                                summaryWS.Range("A" & nextrow) = ws.Name
                                summaryWS.Range("B" & nextrow) = Replace(rng.Address, "$", "")
                                summaryWS.Hyperlinks.Add Anchor:=summaryWS.Range("B" & nextrow), Address:="", SubAddress:="'" & ws.Name & "'!" & rng.Address
                                summaryWS.Range("C" & nextrow) = "'" & rng.Formula
                                summaryWS.Range("D" & nextrow) = filePath
                                summaryWS.Range("E" & nextrow) = linkStatusDescr(ActiveWorkbook.LinkInfo(CStr(filePath), xlLinkInfoStatus))
                                Exit For
                            End If
                        Next namedRng
                    End If
                Next rng
            End If
        Next
        Columns("A:E").EntireColumn.AutoFit
        lastrow = summaryWS.Range("A" & Rows.count).End(xlUp).Row

        For r = 2 To lastrow
            If ActiveSheet.Range("E" & r).Value = "File missing" Then
                countBroken = countBroken + 1
            End If
        Next

        If countBroken > 0 Then
            sInput = MsgBox("Do you want to remove broken links of status 'File missing'?", vbOKCancel + vbExclamation, "Warning")
            If sInput = vbOK Then
                For r = 2 To lastrow
                    If ActiveSheet.Range("E" & r).Value = "File missing" Then
                        Sheets(Range("A" & r).Value).Range(Range("B" & r).Value).ClearContents
                        dummy = MsgBox(countBroken & " broken links removed", vbInformation)
                    End If
                Next
            End If
        End If
    Else
        MsgBox "No external links"
    End If
End Sub
Public Function linkStatusDescr(statusCode)
           Select Case statusCode
                Case xlLinkStatusCopiedValues
                    linkStatusDescr = "Copied values"
                Case xlLinkStatusIndeterminate
                    linkStatusDescr = "Unable to determine status"
                Case xlLinkStatusInvalidName
                    linkStatusDescr = "Invalid name"
                Case xlLinkStatusMissingFile
                    linkStatusDescr = "File missing"
                Case xlLinkStatusMissingSheet
                    linkStatusDescr = "Sheet missing"
                Case xlLinkStatusNotStarted
                    linkStatusDescr = "Not started"
                Case xlLinkStatusOK
                    linkStatusDescr = "No errors"
                Case xlLinkStatusOld
                    linkStatusDescr = "Status may be out of date"
                Case xlLinkStatusSourceNotCalculated
                    linkStatusDescr = "Source not calculated yet"
                Case xlLinkStatusSourceNotOpen
                    linkStatusDescr = "Source not open"
                Case xlLinkStatusSourceOpen
                    linkStatusDescr = "Source open"
                Case Else
                    linkStatusDescr = "Unknown status"
            End Select
End Function

Recherches récentes

billetsalimenter listbox viatableaux wordtransport grilleposition tableau word vbaimage userformcouleur ongletgestiongestion stockgestion paienom ongletonglettrie automatiqueformulaire imagecellulleliste deroulanteincrementerpmujason pmujason