Charger une image

[davidp]

Bonjour le forum,

je me permets de vous déranger pour un problème que je n'arrive pas à résoudre (j'ai trouvé un code dans le forum que j'ai essayé d'adapter...).

A l'aide d'un bouton charger une image ,je cherche à:

*insérer une image dans le cadre "image1"
*éventuellement effacer l'image précedemment chargée pour la remplacer par une nouvelle photo.

*NB: est il possible d'avoir un message si la photo dépasse par exemple 1M°?

Pour la 3eme question ,ce n'est pas la priorité.

Merci d'avance pour votre aide

Bonne soirée à tous

DAVID

 

[skoobi]

Re : Charger une image

Bonsoir,

*éventuellement effacer l'image précedemment chargée pour la remplacer par une nouvelle photo.

Ceci ce produit déjà .

Voici le code modifié pour adapter la taille et la position de l'image, à peaufiner:

Private Sub CommandButton1_Click()
Dim Choix
With ActiveSheet
   Choix = Application.GetOpenFilename("Fichier image(*.gif;*.jpg;*.bmp),*.gif;*.jpg;*.bmp" _
    , , "Choix de l'image", , False)
    If Choix = False Then Exit Sub
    On Error Resume Next
    .Shapes("NewPhoto").Delete
    Range("A9").Select
    .Pictures.Insert(Choix).Name = "NewPhoto"
    With .Shapes("NewPhoto")
[COLOR=Blue][B]        .IncrementLeft 20.25
        .Width = 190[/B][/COLOR]
        End With
End With
End Sub

Pour le 3eme point, je ne sais pas faire.

 

[davidp]

Re : Charger une image

Bonsoir Skoobi,

un grand merci pour ton aide.

La solution me convient parfaitement , le paramêtrage de la taille et le décalage par rapport à la cellule est trés pratique.

Au départ , je désirai que la photo aille dans "image1" (affichage/Barre d'outil/barre d'outil controle/Contrôle image1) mais ta solution est trés bien.

Encore merci pour ton aide

Bonne soirée

DAVID

 

[Staple1600]

Re : Charger une image

Bonsoir à tous


Pour le point 3
Une fonction VBA personnalisée:
GetTheFileSize pour déterminer le "poids" de l'image.

A adapter à ton besoin

Skoobi: je te laisse le soin d'adapter ton code avec cette fonction

Option Explicit
 'auteur: Joost Verdaasdonk
 ' \\ Test sub to return Filesize
Sub GetTheSize()
    Dim sFilePath As String
     
     ' \\ Build path to test file in same folder as this document
    sFilePath = "c:\temp\image.jpg"
     
     ' \\ Call function to return filesize
    MsgBox GetTheFileSize(sFilePath) & " Kb"
End Sub
 
 ' \\ This Function returns the Filesize in Kb
Public Function GetTheFileSize(sPath As String) As Long
    Dim iChannel    As Integer
     
     ' \\ Get free channel (file number)
    iChannel = FreeFile
     
     ' \\ Input file by that channel (file number)
    Open sPath For Input As iChannel
     
     ' \\ Return file size
    GetTheFileSize = Format((LOF(iChannel) / 1024), "#.0")
     
End Function

 

[skoobi]

Re : Charger une image

Salut JM ,

merci pour le coup de main , je mets cela dans la boite .

davidp, si ce n'est déjà fait:

Private Sub CommandButton1_Click()
Dim Choix
With ActiveSheet
   Choix = Application.GetOpenFilename("Fichier image(*.gif;*.jpg;*.bmp),*.gif;*.jpg;*.bmp" _
    , , "Choix de l'image", , False)
    If Choix = False Then Exit Sub
    On Error Resume Next
    .Shapes("NewPhoto").Delete
    Range("A9").Select
    .Pictures.Insert(Choix).Name = "NewPhoto"
    With .Shapes("NewPhoto")
        .IncrementLeft 20.25
        .Width = 190
        End With
End With
If GetTheFileSize(Choix) > 1000 Then MsgBox "La photo dépasse 1Mo", vbInformation
End Sub
 
'This Function returns the Filesize in Kb
Public Function GetTheFileSize(ByVal sPath As String) As Long
Dim iChannel    As Integer
'Get free channel (file number)
iChannel = FreeFile
'Input file by that channel (file number)
Open sPath For Input As iChannel
'Return file size
GetTheFileSize = Format((LOF(iChannel) / 1024), "#.0")
End Function

 

[davidp]

Re : Charger une image

Rebonjour ,

BRAVO ET MERCI, à Staple1600 et SKOOBI.

je ne sais pas comment vous arrivez à réaliser des choses pareilles.

Nb: Je n'avais pas encore adapté le code de staple1600 à la démo (je n'en étais pas capable ...)

Je vous remercie pour votre aide et je suis certain que cela interessera d'autres personnes du forum.

Bonne soirée

DAVID