Discussion :

[norgepagan]

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 :

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

[kiki29]

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

[norgepagan]

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 :

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

[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

[norgepagan]

Bonsoir,

Effectivement cette "vérification" pourrait être utile