Programme qui fonctionnait , ne fonctionne plus ! HELP

Question

Bonjour à tous ceux qui veulent bien m'aider :) Je suis nouvelle sur le forum et débute en VBA que j'utilise dans mon stage pour faire de la cartographie. Mon programme est censé extraire des adresses de contacts pour aller les coller dans un autre classeur excel existant. Ce code fonctionnait très bien sur excel 2007. J'ai l'impression que depuis que je suis sous 2010 en version d'essai ça ne fonctionne plus. En plus, lorsqu'il est exécuté par un autre ordinateur en 2007, ça ne marche pas non plus. J'ai essayé de chercher le problème est je crois que l'affectation des fichiers et l'utilisation des Wbk1 et 2 n'est pas reconnue. Les deux fichiers se trouvent sur un serveur pour être accessibles par tous les employés. Voila le code: Sub Cartographie() Dim lien As String Dim feuill As String On Error Resume Next Application.ScreenUpdating = False ' Copie des adresses ayant un statut specifique dans l'onglet cartographie k = 4 For x = 136 To 1000 If Sheets("Contacts").Cells(x, 8) "Attente retour prediag" Or Sheets("Contacts").Cells(x, 8) "Attente retour questionnaire" Or Sheets("Contacts").Cells(x, 8) = "Prediag en cours" Or Sheets("Contacts").Cells(x, 8) = "Devis envoyé" Or Sheets("Contacts").Cells(x, 8) = "Devis demandé" Or Sheets("Contacts").Cells(x, 8) = "GAGNE !!" Then ' ouverture du lien hypertexte Sheets("Contacts").Cells(x, 1).Select lien = Selection.Hyperlinks(1).SubAddress feuill = Mid(lien, 2, InStr(lien, "!") - 3) Sheets(feuill).Activate ' Copie du nom, de l'adresse, code postal et ville Sheets("Cartographie").Cells(k, 1) = Sheets(feuill).Cells(9, 2) 'copie société Sheets("Cartographie").Cells(k, 2) = Sheets(feuill).Cells(11, 2) ' copie contact Sheets("Cartographie").Cells(k, 3) = Sheets(feuill).Cells(16, 2) 'copie rue Sheets("Cartographie").Cells(k, 4) = Sheets(feuill).Cells(17, 2) ' copie code postal Sheets("Cartographie").Cells(k, 5) = Sheets(feuill).Cells(18, 2) ' copie ville Sheets("Contacts").Activate Sheets("Cartographie").Cells(k, 6) = Sheets("Contacts").Cells(x, 8) 'copie du statut k = k + 1 End If Next ' Suppression des doublons ' Attention nombre de contacts limité a 1000 et 5 colonnes Sheets("Cartographie").Range("$A$4:$F$1000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _ Header:=xlNo ------> Jusque ici tout fonctionne ( donc travaille que sur un classeur) 'Suppression des lignes ou il n'y a pas d'adresse j = 5 Set Wbk1 = ThisWorkbook While Wbk1.Sheets("Cartographie").Cells(j, 2) <> Empty If Wbk1.Sheets("Cartographie").Cells(j, 5) = "" Then Sheets("Cartographie").Cells(j, 2).EntireRow.Delete End If j = j + 1 Wend ' Copie des adresses de cartographie dans le convertisseur GE Set Wbk2 = Workbooks.Open("\adresse du serveur\public\Creation_cartographie.xls") Application.ActiveProtectedViewWindow.Edit Wbk1.Sheets("Cartographie").Activate Wbk2.Sheets("Data").Activate ' Remplissage de la colonne Nom du convertisseur l = 5 j = 2 Dim Societe As String Dim Nomcontact As String While Wbk1.Sheets("Cartographie").Cells(l, 2) <> "" Societe = Wbk1.Sheets("Cartographie").Cells(l, 1) Nomcontact = Wbk1.Sheets("Cartographie").Cells(l, 2) Wbk2.Sheets("Data").Cells(j, 1) = Societe & " " & Nomcontact l = l + 1 j = j + 1 Wend End sub Je fais d'autres choses après mais c'est le début qui ne marche pas. A mon avis c'est l'appel et l'assignation des fichiers a Wbk1 et Wbk2 qui ne marche pas ... Avez vous des idées ou trouvez vous des erreurs, car je desespère un peu .. Merci beaucoup d'avance !!!! :)

MarcPL · Answer

Bonjour !   Commencer par désactiver en début de procédure la ligne On Error Resume Next ...

Puis relancer la procédure afin de savoir où l'erreur se trouve, par exemple un nom de feuille
ou l'adresse du serveur entres autres ...
___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !

ucfoutu · Answer

Bonjour,
veux-tu bien, s'il te plait, nous présenter ton code indenté et entre balises code (3ème icône en partant de la droite) ?
De sorte à ce que nous puissions l'examiner sans risquer un torticolis.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Utilisateur anonyme · Answer

Bonjour,

À première vue, il manque quelques guillements dans ces lignes:

Sheets("Cartographie").Cells(k, 1) = Sheets(feuill).Cells(9, 2) 'copie société 
Sheets("Cartographie").Cells(k, 2) = Sheets(feuill).Cells(11, 2) ' copie contact
Sheets("Cartographie").Cells(k, 3) = Sheets(feuill).Cells(16, 2) 'copie rue 
Sheets("Cartographie").Cells(k, 4) = Sheets(feuill).Cells(17, 2) ' copie code postal
Sheets("Cartographie").Cells(k, 5) = Sheets(feuill).Cells(18, 2) ' copie ville 

Je dirais que c'est un des risques de 

on error resume next

ucfoutu · Answer

Bonjour, cmarcotte.
Tu lis trop vite et n'as pas vu :
lien =  Selection.Hyperlinks(1).SubAddress
 feuill   = Mid(lien, 2, InStr(lien, "!") - 3) 

Je me suis arrêté là dans ma lecture, que je ne reprendrai que lorsque le demandeur aura présenté un code indenté et entre balises code.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Programme qui fonctionnait , ne fonctionne plus ! HELP

4 réponses

Votre réponse

Discussions similaires