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 !!!!
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 !!!!