Macro d'import

Résolu

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 - 13 avril 2010 à 10:45
houtas - 10 mai 2010 à 17:38

Bonjour,

j'ai un message d'erreur lorsque j'exécute la macro ci-dessous :

voici mon code dans Microsoft Visual Basic :
----------------------
Dim num_ligne As Integer
Dim zone_1 As String
Dim zone_2 As String
Dim zone_3 As String
Dim zone_4 As String
Dim zone_5 As String
Dim fic_n As String
Sub Import()
'
' Import Macro
' Importe les données
On Error Resume Next
num_ligne = 2
Do While Mid(Feuil1.Cells(num_ligne, 1), 1, 3) <> ""
zone_1 = Sheets("LIENS")(Feuil1.Cells(num_ligne, 1))
zone_2 = Sheets("LIENS")(Feuil1.Cells(num_ligne, 4))
zone_3 = Sheets("LIENS")(Feuil1.Cells(num_ligne, 5))
zone_4 = Sheets("LIENS")(Feuil1.Cells(num_ligne, 6))
zone_5 = Sheets("LIENS")(Feuil1.Cells(num_ligne, 7))
mon_classeur = ActiveWorkbook.Name
Application.ScreenUpdating = False
'Je teste si le fichier est déjà ouvert
Application.DisplayAlerts = False
On Error GoTo deja_ouvert
Workbooks.Open Filename:=Range(zone_1), UpdateLinks:=0
On Error GoTo 0
deja_ouvert:
Workbooks(mon_classeur).Activate
Sheets("SERVEUR").Range(zone_2).Value = Workbooks(zone_1).Sheets("SYNTHESE").Range(zone_4).Value
Sheets("SERVEUR").Range(zone_3).Value = Workbooks(zone_1).Sheets("SYNTHESE").Range(zone_5).Value
Workbooks(zone_1).Close (False)
num_ligne = num_ligne + 1
Loop
Sheets("LIENS").Select
MsgBox ("FIN")
End Sub
----------------------

Voici l'erreur qui s'affiche :
Erreur d'exécution '13' : Incompatibilité de type

Merci de votre aide.

A voir également:

Macro d'import
Automatiser import excel vers access - Forum Visual Basic
Import excel vers access ✓ - Forum Visual Basic 6
Macro excel ✓ - Forum Visual Basic 6
C# import dll ✓ - Forum C# / .NET
Supprimer bouton macro excel ✓ - Forum VB.NET

37 réponses

Réponse 21 / 37

NikatorS Messages postés 147 Date d'inscription mercredi 18 septembre 2002 Statut Membre Dernière intervention 15 avril 2011
15 avril 2010 à 17:47

Essaie ça

Workbooks(zone_1_bis).Sheets("SYNTHESE").Range(zone_4).Copy
Sheets("SERVEUR").Range(Mid(zone_2, 1, InStr(zone_2, ":") - 1)).Select
Sheets("SERVEUR").Paste

Remplace zone_1_bis par zone_1 si dans la barre de titre de ton fichier excel tu vois C:\Users\IT.xls au lieu de IT.xls

S Nikator

Réponse 22 / 37

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
15 avril 2010 à 20:34

Fazpedro,
Rien n'y fait : j'ai un doute sur ce (zone_1_bis) qui est tantôt appelé, tantôt non, comme dans tes 2 lignes ci-dessous

Sheets("SERVEUR").Range(zone_2).Value = Workbooks(zone_1_bis).Sheets("SYNTHESE").Range(zone_4).Value 
'=> (ZONE_1_BIS) : ???
Sheets("SERVEUR").Range(zone_3).Value = Workbooks(zone_1).Sheets("SYNTHESE").Range(zone_5).Value 
' => (ZONE_1)

J'aimerais comprendre pourquoi, ou si ça t'a échappé

Cdt
Rataxes64

Réponse 23 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
16 avril 2010 à 08:49

Ca ne fonctionne toujours pas !

Réponse 24 / 37

NikatorS Messages postés 147 Date d'inscription mercredi 18 septembre 2002 Statut Membre Dernière intervention 15 avril 2011
16 avril 2010 à 09:00

Si tu pouvais m'envoyais ton fichier par mail, j'aimerai le voir.
On échange nos emails en MP.

S Nikator

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 25 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
19 avril 2010 à 08:41

Bonjour S Nikator,

cela fonctionne bien,
maintenant, si un des fichiers n'existe pas, je voudrais qu'il continue vers le bas sans s'arrêter à la ligne :
Sheets("SERVEUR").Range(zone_1).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_3).Value

Ici, le fichier IT_FM n'est pas présent mais les autres fichiers suivants le sont.

Merci de ton aide.
Bonne journée.

Réponse 26 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
19 avril 2010 à 11:35

Bonjour,

cela fonctionne très bien avec le code ainsi modifié (j'ai rajouté en plus un compteur de durée) :

------------
Dim num_ligne As Integer
Dim zone_1 As String
Dim zone_2 As String
Dim zone_3 As String
Dim zone_4 As String
Dim zone_5 As String
Dim fic_n As String
Sub Import()
'
' Import Macro
' Importe les données
Dim num_ligne As Integer
Dim Ville_Overture As String
Dim Ville As String
Dim zone_1 As String
Dim zone_2 As String
Dim zone_3 As String
Dim zone_4 As String
Dim t

On Error Resume Next
num_ligne = 2
t = Time
Do
Do While Mid(Feuil1.Cells(num_ligne, 1), 1, 3) <> ""
Sheets("LIENS").Select
Ville_Overture = Sheets("LIENS").Cells(num_ligne, 1)
Ville = Mid(Ville_Overture, InStrRev(Ville_Overture, "") + 1)
zone_1 = Sheets("LIENS").Cells(num_ligne, 4)
zone_2 = Sheets("LIENS").Cells(num_ligne, 5)
zone_3 = Sheets("LIENS").Cells(num_ligne, 6)
zone_4 = Sheets("LIENS").Cells(num_ligne, 7)
mon_classeur = ActiveWorkbook.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On AllError GoTo fic_inexistant
Workbooks.Open Filename:=Ville_Overture, UpdateLinks:=0
Workbooks(mon_classeur).Activate
Sheets("SERVEUR").Range(zone_1).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_3).Value
Sheets("SERVEUR").Range(zone_2).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_4).Value
Workbooks(Ville).Close (False)
fic_inexistant:
num_ligne = num_ligne + 1
Loop
DoEvents
Loop While Time <= t + TimeValue("00:00:10")
t = Time - t
Sheets("MENU").Select
MsgBox ("Les données ont bien été importées depuis le serveur en " & Minute(t) & " Minute(s)" & Second(t) & " seconde(s)")
End Sub
------------

Réponse 27 / 37

NikatorS Messages postés 147 Date d'inscription mercredi 18 septembre 2002 Statut Membre Dernière intervention 15 avril 2011
19 avril 2010 à 12:00

Do While Mid(Feuil1.Cells(num_ligne, 1), 1, 3) <> ""
If "" = Dir(Ville_Overture) Then GoTo Suite

Sheets("LIENS").Select
Ville_Overture = Sheets("LIENS").Cells(num_ligne, 1) 'C:\Users\IT.xls
Ville = Mid(Ville_Overture, InStrRev(Ville_Overture, "") + 1)
zone_1 = Sheets("LIENS").Cells(num_ligne, 4) 'B4:H4
zone_2 = Sheets("LIENS").Cells(num_ligne, 5) 'I4:O4
zone_3 = Sheets("LIENS").Cells(num_ligne, 6) 'M7:S7
zone_4 = Sheets("LIENS").Cells(num_ligne, 7) 'U7:AA7

mon_classeur = ActiveWorkbook.Name

Application.ScreenUpdating = False

'Je teste si le fichier est déjà ouvert
Application.DisplayAlerts = False
On Error GoTo deja_ouvert
Workbooks.Open Filename:=Ville_Overture, UpdateLinks:=0
On Error GoTo 0
deja_ouvert:
Workbooks(mon_classeur).Activate
Sheets("SERVEUR").Range(zone_1).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_3).Value
Sheets("SERVEUR").Range(zone_2).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_4).Value
Workbooks(Ville).Close (False)

Suite:
num_ligne = num_ligne + 1

Loop

S Nikator

Réponse 28 / 37

NikatorS Messages postés 147 Date d'inscription mercredi 18 septembre 2002 Statut Membre Dernière intervention 15 avril 2011
19 avril 2010 à 12:02

Petite erreur ...

Do While Mid(Feuil1.Cells(num_ligne, 1), 1, 3) <> ""

Sheets("LIENS").Select
Ville_Overture = Sheets("LIENS").Cells(num_ligne, 1) 'C:\Users\IT.xls
Ville = Mid(Ville_Overture, InStrRev(Ville_Overture, "") + 1)
zone_1 = Sheets("LIENS").Cells(num_ligne, 4) 'B4:H4
zone_2 = Sheets("LIENS").Cells(num_ligne, 5) 'I4:O4
zone_3 = Sheets("LIENS").Cells(num_ligne, 6) 'M7:S7
zone_4 = Sheets("LIENS").Cells(num_ligne, 7) 'U7:AA7

If "" = Dir(Ville_Overture) Then GoTo Suite

mon_classeur = ActiveWorkbook.Name

Application.ScreenUpdating = False

'Je teste si le fichier est déjà ouvert
Application.DisplayAlerts = False
On Error GoTo deja_ouvert
Workbooks.Open Filename:=Ville_Overture, UpdateLinks:=0
On Error GoTo 0
deja_ouvert:
Workbooks(mon_classeur).Activate
Sheets("SERVEUR").Range(zone_1).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_3).Value
Sheets("SERVEUR").Range(zone_2).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_4).Value
Workbooks(Ville).Close (False)

Suite:
num_ligne = num_ligne + 1

Loop

S Nikator

Réponse 29 / 37

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
19 avril 2010 à 12:24

Salut,
Attention à If Dir(.... qui retourne la même chose si le répertoire existe, mais est vide, ou si le répertoire n'existe pas.

Cdt
Rataxes64

Réponse 30 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
19 avril 2010 à 15:35

Avec ceci, cela fonctionne, le seul problème vient du fait qu'il ne me recopie pas la valeur des cellules d'origine si celles-ci contiennent déjà des liens ou formules du style : ='CUMUL ANNUEL'!D41-'CUMUL ANNUEL'!D47
ou : = [IT_12.xls]UT'!G19

Merci de votre aide.
***************
Sub Import()
Dim num_ligne As Integer
Dim Ville_Overture As String
Dim Ville As String
Dim zone_1 As String
Dim zone_2 As String
Dim zone_3 As String
Dim zone_4 As String
Dim t

On Error Resume Next
num_ligne = 2
t = Time
Do
Do While Mid(Feuil1.Cells(num_ligne, 1), 1, 3) <> ""
Ville_Overture = Sheets("LIENS").Cells(num_ligne, 1)
Ville = Mid(Ville_Overture, InStrRev(Ville_Overture, "") + 1)
zone_1 = Sheets("LIENS").Cells(num_ligne, 4)
zone_2 = Sheets("LIENS").Cells(num_ligne, 5)
zone_3 = Sheets("LIENS").Cells(num_ligne, 6)
zone_4 = Sheets("LIENS").Cells(num_ligne, 7)
mon_classeur = ActiveWorkbook.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On AllError GoTo fic_inexistant
Workbooks.Open Filename:=Ville_Overture, UpdateLinks:=1
Workbooks(mon_classeur).Activate
Workbooks(mon_classeur).Sheets("SERVEUR").Range(zone_1).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_3).Value
Workbooks(mon_classeur).Sheets("SERVEUR").Range(zone_2).Value = Workbooks(Ville).Sheets("SYNTHESE").Range(zone_4).Value
Workbooks(Ville).Close (False)
fic_inexistant:
num_ligne = num_ligne + 1
Loop
DoEvents
Loop While Time <= t + TimeValue("00:00:10")
t = Time - t
MsgBox ("Les données ont bien été importées depuis le serveur en " & Minute(t) & " Minute(s)" & Second(t) & " seconde(s)")
End Sub
***************

Réponse 31 / 37

NikatorS Messages postés 147 Date d'inscription mercredi 18 septembre 2002 Statut Membre Dernière intervention 15 avril 2011
19 avril 2010 à 19:52

Ce coup ci, je t'oriente seulement.
Une cellule à plusieurs proprièté pour retouner ce qu'elle contient :
- FormulaR1C1
- Value
- Text

S Nikator

Réponse 32 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
20 avril 2010 à 09:58

Bonjour S Nikator

Désolé, mais je ne suis pas fort pour les devinettes, peux-tu éclaircir ?

Merci.

Réponse 33 / 37

NikatorS Messages postés 147 Date d'inscription mercredi 18 septembre 2002 Statut Membre Dernière intervention 15 avril 2011
20 avril 2010 à 16:06

Regarde ce que te renvoie ces différents codes :

Workbooks(Ville).Sheets("SYNTHESE").Cells("M7:S7", 4).FormulaR1C1
Workbooks(Ville).Sheets("SYNTHESE").Cells("M7", 4).FormulaR1C1

Workbooks(Ville).Sheets("SYNTHESE").Cells("M7:S7", 4).Value
Workbooks(Ville).Sheets("SYNTHESE").Cells("M7", 4).Value

Workbooks(Ville).Sheets("SYNTHESE").Cells("M7:S7", 4).Text
Workbooks(Ville).Sheets("SYNTHESE").Cells("M7", 4).Text

S Nikator

Réponse 34 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
21 avril 2010 à 09:57

Bonjour S Nikator
Désolé, mais cela ne renvoie rien.

Réponse 35 / 37

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
21 avril 2010 à 11:02

Salut,
Un extrait de code d'une de mes appli, à adapter bien sûr :

A = Range("A65536").End(xlUp).Row
Range("L2").Select
Feuil1.Range("L2").ClearContents
Range("L2").Activate
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[2]C:R[" & A - 2 & "]C)" 
NbRetard = Range("L2").Value

Selectionne et Vide la valeur dans la cell L2, confirme son activation, transcrit la copie d'une formule "soustotal" d'une cible de la même colonne à partir d'une ligne donnée (4), dont le nombre total de lignes à prendre en compte dépend d'un nombre de lignes non vides dans une autre colonne (A), et renvoie le résultat dans la cell L2

=> dans la même colonne : pas de valeur [...] derrière C

=> depuis la deuxième ligne sous la ligne de la cellule active (ici R[2] renvoie donc 4)

=> jusqu'à la denière ligne non nulle (incluse) relevée dans la colonne A (R[" & A - 2 & "])

En espérant que ça t'aide (j'ai volontairement "chargé" chaque ligne de script ; certaines peuvent être inutiles en l'état)

Cdt
Rataxes64

Réponse 36 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
22 avril 2010 à 15:59

Bonjour,

En fait cela fonctionne bien : le seul problème est que certains fichiers source n'avaient pas le bon nom d'onglet "SYNTHESE"
c'est rectifié et c'est OK
Workbooks(Ville).Sheets("SYNTHESE")

Merci à vous.

Réponse 37 / 37

fazpedro Messages postés 22 Date d'inscription jeudi 18 juin 2009 Statut Membre Dernière intervention 10 mai 2010 1
10 mai 2010 à 15:22

Bonjour,

une dernière chose :
comment éviter d'avoir à cliquer quand j'ai le message suivant : "Ce classeur contient une ou plusieurs liaisons qui ne peuvent être mises à jour"

Si je clique sur "Continuer" c'est bon mais je voudrais que le "clic" soit effectué en automatique et qu'il n'y ait pas d'arrêt !

Merci beaucoup.

Discussions similaires

Récupérer par une macro les dimension d'une pièce sur CATIA

Activer macros outlook

comment activer les macro dans outlook

Les macros sur Outlook ne fonctionnent plus et ne sont plus accessibles !

Ouverture d'un formulaire outlook par macro

Votre réponse

Discussions similaires