[VBA] Importer une image d'un fichier excel vers un autre

**norgepagan** · 01/05/2011, 11h28

Bonjour,

Je sais comment importer une image depuis un répertoire, mais comme mon image actuelle est plutôt un groupe d'éléments contenant une image et 3 champs texte, j'aimerais l'importer depuis un autre fichier.

En fonction d'un type de pompes, j'importe déjà des caractéristiques de celle ci. J'aimerais en plus importer l image. Je pense donc rajouter les lignes manquantes dans ma fonction Importer', puisque l'image se trouvera dans le même fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
 
Public Function FichierExiste(S As String) As Boolean
Dim obj As Object
    Set obj = CreateObject("Scripting.FileSystemObject")
    FichierExiste = obj.FileExists(S)
End Function
 
Function DossierExiste(NomDossier As String) As Boolean
    DossierExiste = Dir(NomDossier, vbDirectory) <> ""
End Function
 
Private Function Test() As String
    Dim Chemin As String
    If DossierExiste("C:\Pompes_BDD") = True Then
        Chemin = "C:\Pompes_BDD"
    Else
        Dim objShell As Object, objFolder As Object, oFolderItem As Object
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.BrowseForFolder(&H0&, " C:\Pompes_BDD n'existe pas, veuillez choisir un autre répertoire", &H1&)
        On Error Resume Next
        Set oFolderItem = objFolder.Items.Item
        Chemin = oFolderItem.Path
    End If
    Test = Chemin
End Function
 
Private Function Importer(TypePompe As String) As Boolean
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim Nom As String
 
    Application.ScreenUpdating = False
 
    Nom = Test & "\" & TypePompe & ".xlsx"
    If FichierExiste(Nom) = True Then
        Set Wb = Workbooks.Open(Nom, , True)
        Set Ws = Wb.Worksheets(1)
        Ws.Range("A3:D8").Copy ThisWorkbook.Worksheets(1).Range("A31")
        Wb.Close
        Application.ScreenUpdating = True
        Set Ws = Nothing
        Set Wb = Nothing
        Importer = True
    Else
        MsgBox ("Erreur : le type de pompe ne correspond à aucun fichier.")
        Importer = False
    End If
End Function
 
Private Sub Sauvegarder()
    Dim Nom As String
    Nom = Range("C1").Value & " " & Range("G1").Value & " " & Range("H1").Value & " HP " & Range("D6").Value
    ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & Nom
    rep = MsgBox("Votre fichier a bien été sauvegardé sous le nom : " & Nom, vbYes + vbInformation, "Copie sauvegarde classeur")
End Sub
 
 
Private Sub Ok_Click()
    If StationText.Value = "" Or SDMText.Value = "" _
        Or TypeText.Value = "" Or NText.Value = "" _
        Or NJCText.Value = "" Or PuiText.Value = "" _
        Or IntText.Value = "" Or ViText.Value = "" _
        Or NiveauText.Value = "" Then
        MsgBox "Erreur : Veuillez remplier tous les champs."
    ElseIf IsNumeric(PuiText.Value) = False _
        Or IsNumeric(IntText.Value) = False _
        Or IsNumeric(ViText.Value) = False _
        Or IsNumeric(NiveauText.Value) = False Then
        MsgBox "Erreur : les champs Puissance moteur, Intensité moteur et Vitesse de référence doivent être numérique."
    Else
        Range("C1").Value = StationText.Value
        Range("H1").Value = SDMText.Value
        Range("A6").Value = TypeText.Value
        Range("B6").Value = NText.Value
        Range("D6").Value = NJCText.Value
        Range("F6").Value = PuiText.Value
        Range("H6").Value = IntText.Value
        Range("J6").Value = ViText.Value
        Range("K29").Value = NiveauText.Value
        If Importer(TypeText.Value) = True Then
            'Sauvegarder
            Unload Me
        End If
    End If
End Sub

Merci d'avance à ceux qui pourront m'aider.

**patricktoulon** · 01/05/2011, 18h04

bonjour

j'avoue que ton explication n'est pas clair du tout

tu dis que tu veux importer l'image par un autre fichier et ensuite tu dis que l'image est dans le meme fichier

dur dur

au plaisir

**norgepagan** · 01/05/2011, 20h27

Bonjour,

J'importe l'image depuis un autre fichier (que le fichier courant), depuis lequel j'importe déjà une plage de données.

C'est plus clair ?

**patricktoulon** · 02/05/2011, 12h35

bonjour

je vais essayer d'etre plus clair

quand tu dis que tu importe l'image a partir d'un autre fichier

tu importe l'image a partir du disque dur ou a partir d'un autre fichier exel

au plaisir

**norgepagan** · 02/05/2011, 19h47

Bonjour,

Depuis un autre fichier excel (duquel j importe déjà une plage de données [fonction importer])

**patricktoulon** · 05/05/2011, 17h27

bonjour

bon c'est deja plus clair

alors voila un exemple de macro

cette macro doit etre dans le classeur ou dois atterrir l'image

le code est commenté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub récupere_l_image()
Application.DisplayAlerts = False 'on bloque les fenetre d'avertissement
Application.ScreenUpdating = False 'on bloque le rafraichissement de la feuille a l'ecran
 
Dim wks1 As Object
Dim wks2 As Object 'les variable de type workbook
 
Dim nom_de_l_image As String 'ON DECLARE UNE VARIABLE STRING POUR LE NOM DE L'IMAGE
Dim titre  As String ' On declare une variable string pour le nom du classeur dans le quel tu va aller chercher l'image
Set wks1 = ThisWorkbook 'on donne la valeur du classueur actuel a la variable wks1
'************************************************************************************
'on donne la chaine de caractere contenant l'adresse complete _
 du chemin du classeur ou tu va aller piquer l'image a la variable tritre
  titre = "C:\Users\Patrick\Desktop\classeur 1.xls"
'**************************************************************************************
'on donne la chaine de caractere a la variable nom de limage  constituant le nom de l'image que tu va piquer
 nom_de_l_image = "Image 1"
'****************************************************************************************
 'on ouvre le classeur
 Workbooks.Open titre
'****************************************************************************************
'on determine la valeur de wks2
Set wks2 = ActiveWorkbook
'********************************************************************************************
'on copie l'image
wks2.Sheets("feuil1").Shapes(nom_de_l_image).Copy ' dans mon example l'image se trouve dans le sheets "feuil1" ca peut etre different chez toi
'********************************************************************************************
' on reactive le classeur de destination
wks1.Activate
'*******************************************************************************************
'on colle
ActiveSheet.Paste
'*****************************************************************************************
'on ferme le classeur ou etait l'image
wks2.Close
End Sub

c'est pas beau la vie

au plaisir

**norgepagan** · 21/05/2011, 12h30

Bonjour,

J'ai regardé (tardivement) ce que tu m'avais donné, j'ai une erreur
"L'indice n'appartient pas à la sélection" sur la ligne "wks2.Sheets("feuil1").Shapes(nom_de_l_image).Copy"

[VBA] Importer une image d'un fichier excel vers un autre

Macros et VBA Excel

Discussions similaires

Partager

Partager