Extraction de données
Bonjour,
Je dois réaliser avec Excel 2010 sur une application de "suivi de budget" pour des projets. Pour cela je dois aller extraire des données dans d'autre fichiers Excels. Pour récupérer les données ds le premier fichier pas de soucis mais pour le deuxiéme mon programme bloque alors que j'utilise la mm façon de programmer. Je me demandais si ce n'était pas parce que le fichier ou je dois extraire des données est protégé par un mot de passe??
Voila mon programme:
Sub EXTRACTION_CONTRAT()
Application.ScreenUpdating = False '-- fige les écrans
Calculate ' actualisation de la feuille de calcul
MOIS = ""
ANNEE = ""
CdP = ""
PROJET = numero_projet
PHASE = ActiveSheet.Cells(3, 4)
MOIS = ActiveSheet.Cells(4, 4)
ANNEE = ActiveSheet.Cells(5, 4)
CdP = ActiveSheet.Cells(6, 4)
RECHERCHE_MOIS
m = 0 ' COLONNE_DATE
i = 3 ' OFFSET_COLONNE_DATE
j = 8 ' OFFSET_LIGNE_DATE
Do Until ActiveSheet.Cells(j, i + m) = "01/" + CHIFFRE_MOIS + "/" + ANNEE '----répéter l'action juqu'à la fin de la feuille
If m = 10000 Then
Exit Do ' Permet de sortir de la boucle en cas de non existence de la date
Else
x = "01/" + CHIFFRE_MOIS + "/" + ANNEE
tempo = ActiveSheet.Cells(j, i + m)
m = m + 1
End If
Loop
m = m + i
NOM_FICHIER_CONTRAT = "CONTRAT-" + PROJET + "-" + PHASE + "-" + CdP + ".xlsm" ' Nom du fichier SAP à extraire
EXTRACTION_DATAS_CONTRAT
ECRITURE_DATAS_CONTRAT
Calculate ' actualisation de la feuille de calcul
Application.ScreenUpdating = True '-- Libère les écrans
End Sub
Sub EXTRACTION_DATAS_CONTRAT()
k = 3
x = 0
On Error Resume Next
myfolder = "\\fs-fr-lav02\Inter\Outils Projets\03 - Contrats\Contrats Validés\test\*.xlsm"
myfile = Dir(myfolder)
Do While myfile <> ""
If NOM_FICHIER_CONTRAT = myfile Then
x = 1
End If
myfile = Dir
Loop
If x = 1 Then
Workbooks.Open Filename:="\\fs-fr-lav02\Inter\Outils Projets\03 - Contrats\Contrats Validés\test\" + NOM_FICHIER_CONTRAT
Windows(NOM_FICHIER_CONTRAT + ".xlsm").Activate // Mon problème se trouve ici : mon programme s'arrête
Sheets("contrat").Select
Do Until ActiveSheet.Cells(k, 1) = "ET"
If ActiveSheet.Cells(k, 2) = "001" Then
ET001 = ActiveSheet.Cells(k, 7)
End If
If ActiveSheet.Cells(k, 2) = "002" Then
ET002 = ActiveSheet.Cells(k, 7)
End If
If ActiveSheet.Cells(k, 2) = "003" Then
ET003 = ActiveSheet.Cells(k, 7)
End If
If ActiveSheet.Cells(k, 2) = "004" Then
ET004 = ActiveSheet.Cells(k, 7)
End If
If ActiveSheet.Cells(k, 2) = "005" Then
ET005 = ActiveSheet.Cells(k, 7)
End If
If ActiveSheet.Cells(k, 2) = "006" Then
ET006 = ActiveSheet.Cells(k, 7)
End If
If ActiveSheet.Cells(k, 2) = "007" Then
ET007 = ActiveSheet.Cells(k, 7)
End If
If ActiveSheet.Cells(k, 2) = "008" Then
ET008 = ActiveSheet.Cells(k, 7)
End If
k = k + 1
Loop
ActiveWindow.Close
End If
End Sub
Sub ECRITURE_CONTRAT()
Sheets(PHASE).Select
ActiveSheet.Cells(60, m) = ET001
ActiveSheet.Cells(61, m) = ET002
ActiveSheet.Cells(62, m) = ET003
ActiveSheet.Cells(63, m) = ET004
ActiveSheet.Cells(64, m) = ET005
ActiveSheet.Cells(65, m) = ET006
ActiveSheet.Cells(66, m) = ET007
ActiveSheet.Cells(67, m) = ET008
ET001 = ""
ET002 = ""
ET003 = ""
ET004 = ""
ET005 = ""
ET006 = ""
ET007 = ""
ET008 = ""
End Sub
Je vous remercie par avance pour l'attention que vous porterez à ma demande;
Bonjour,
Il y a très peu de médiums dans ce forum :-)
Il faut nous mettre un peu sur la piste du bug. Sur quelle ligne de code s'arrête la macro et quel est le message ?
Si tu as un fichier avec un mot de passe, il faut bien évidement mettre dans le code d'ouverture du fichier le mot de passe pour qu'Excel puisse l'ouvrir:
Workbooks.Open "C:\Monchemin\Monfichier.xlsx", , , , "lemotdepasse"