Importer une image depuis windows

Version imprimable

Bonjour,

Je sais que le sujet a été traité un nombre incalculable de fois mais rien ne semble marcher chez moi.

J'aimerais importer une image depuis mon disque dur, en fonction d'un nom, et la coller dans un zone de mon tableau. Or les images pouvant etre verticale ou horizontale, je dois redéfinir la taille de la zone selon celle de l'image, et je ne trouve pas ..

Merci d'avance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 NomImage = Test & "\" & TypePompe & ".png" If FichierExiste(NomImage) Then Dim zone As String If ?? Then zone = "F15:M26" Else zone = "F11:H32" End If Dim Shp As Shape Set Shp = Feuil1.Shapes.AddPicture(NomImage, msoFalse, msoCTrue, _ ActiveSheet.Range(zone).Left, _ ActiveSheet.Range(zone).Top, _ ActiveSheet.Range(zone).Width, _ ActiveSheet.Range(zone).Height) Importer = True End If

29/05/2011, 17h52
kiki29

Salut,tu devrais voir dans la FAQ http://excel.developpez.com/faq/?page=Image

J'ai du changer mes images en .jpg au lieu de .png et ca marche !

Merci beaucoup ;)

Ma fonction d'import donne donc ca :

Code:

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
Private Function Importer(TypePompe As String) As Boolean
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim NomClasseur As String
    Dim NomImage As String
 
    Application.ScreenUpdating = False
    NomClasseur = Test & "\" & TypePompe & ".xlsx"
    If FichierExiste(NomClasseur) = True Then
        Set Wb = Workbooks.Open(NomClasseur, , True)
        Set Ws = Wb.Worksheets(1)
        Ws.Range("A3:D8").Copy ThisWorkbook.Worksheets(1).Range("A39")
        Wb.Close
        Application.ScreenUpdating = True
        Set Ws = Nothing
        Set Wb = Nothing
        NomImage = Test & "\" & TypePompe & ".jpg"
        If FichierExiste(NomImage) Then
            Dim iPict As IPictureDisp
            Dim zone As String
            Set iPict = LoadPicture(NomImage)
            If iPict.Width >= iPict.Height Then
                Set iPict = Nothing
                zone = "F15:M30"
            Else
                ThisWorkbook.Worksheets(1).Range("F11:G13").Cut ThisWorkbook.Worksheets(1).Range("L14")
                ThisWorkbook.Worksheets(1).Range("H11:I13").Cut ThisWorkbook.Worksheets(1).Range("L18")
                ThisWorkbook.Worksheets(1).Range("J11:K13").Cut ThisWorkbook.Worksheets(1).Range("L22")
                ThisWorkbook.Worksheets(1).Range("L11:M13").Cut ThisWorkbook.Worksheets(1).Range("L26")
 
                ThisWorkbook.Worksheets(1).Range("E10:N34").Interior.ColorIndex = 2
                zone = "F11:H32"
            End If
            Dim Shp As Shape
            Set Shp = Feuil1.Shapes.AddPicture(NomImage, msoFalse, msoCTrue, _
            ActiveSheet.Range(zone).Left, _
            ActiveSheet.Range(zone).Top, _
            ActiveSheet.Range(zone).Width, _
            ActiveSheet.Range(zone).Height)
            Importer = True
        End If
    Else
        MsgBox ("Erreur : le type de pompe ne correspond à aucun fichier.")
        Importer = False
    End If
End Function

Des conseils d'optimisation ?

30/05/2011, 01h38
kiki29

Salut,plutût un conseil, intéresse toi au CodeName ,pour cela voir http://www.developpez.net/forums/d92...cel/vba-bases/
Cela présente l'avantage de ne pas avoir à toucher au code VBA si l'utilisateur déplace une feuille, la renomme ou en ajoute
30/05/2011, 21h58
norgepagan

Bonsoir,

Effectivement cette "vérification" pourrait être utile