Ratio image en Useform

Version imprimable

19/03/2020, 09h01
papy_polo67

1 pièce(s) jointe(s)

Ratio image en Useform

Bonjour le Forum

je vous mets en copie le fichier sur lequel je travaille
je voudrais appliquer un ratio image pour qu'elles s'affichent plein cadre sans devoir modifier leurs tailles.
J'ai bien un autre exemple ou les images s'affichent dans des cellules, mais pas dans un Useform et je ne sais comment l'adapter.
Pourriez vous m'aider et éventuellement décrire la procédure?
Merci
Ps les images de la feuille "Reines" ne sont que les miniatures de celles qui devront s'afficher dans l'UseForm. les originales sont stockées ailleurs
19/03/2020, 09h14
riaolle

Bonjour papy_polo67,
Je ne suis pas sûre que je pourrai répondre à ta question, mais je te donne un conseil quand même : évite les pièces jointes dans tes messages, peu de membres les ouvrent. Pour avoir plus rapidement une réponse, utilise donc la copie d'écran pour expliquer ton problème. Voici le pourquoi du comment : https://www.developpez.net/forums/d8...s-discussions/
A bientôt ;)
19/03/2020, 09h15
Ericcool02

Bonjour le forum
Bonjour papy_polo
Edit : Bonjour riaolle (pas rafraîchi)
De mémoire, je pense qu'il te faut "jouer" avec la propriété PictureSizeMode du contrôle Image.
Bonne journée et pensez toutes & tous à vous protéger
@+

Voila les codes
Pour la recherche et l'affichage de l'image du personnage et l'autre pour affichage du blason

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
Private Sub CommandButton2_Click()
                                          'https://www.youtube.com/watch?v=KaAsd8n1u98
'Double click Bouton Rechercher
If Not ComboBox1.Value = "" Then
 
    Dim MonFichier As String
    Dim MonBlason As String
 Nom = ComboBox1.Value
MonFichier = ("C:\Users\Polo\Documents\Fiches Généalogie\Dossier Image Reines de France\") & Nom & (".jpg")
MonBlason = ("C:\Users\Polo\Documents\Fiches Généalogie\Dossier Image Reines de France\Blason\") & Nom & (".jpg")
 
    Dim no_ligne As Integer
 
        no_ligne = ComboBox1.ListIndex + 2
        TextBox1.Value = Cells(no_ligne, 1).Value
        ComboBox1.Value = Cells(no_ligne, 3).Value
        TextBox2.Value = Cells(no_ligne, 4).Value
        TextBox3.Value = Cells(no_ligne, 5).Value
        TextBox4.Value = Cells(no_ligne, 6).Value
        TextBox7.Value = Cells(no_ligne, 7).Value
 
        Else
    End If
 
        If FichierExiste(MonFichier) = True Then
        'MsgBox "Le fichier existe..."
        Image1.Picture = LoadPicture(MonFichier)
    Else
        MsgBox "Le fichier image n'existe pas..."
       Image1.Picture = LoadPicture
 
    End If
        If FichierExiste(MonBlason) = True Then
        'MsgBox "Le fichier existe..."
        Image2.Picture = LoadPicture(MonBlason)
    Else
        MsgBox "Le fichier image n'existe pas..."
       Image2.Picture = LoadPicture
 
    End If
End Sub

Et le code qui devrait vider les cases mais qui apparemment ne fonctionne pas

Code:

1
2
3
4
5
6
7
8
Public Function FichierExiste(MonFichier As String)
 
 If Len(Dir(MonFichier)) > 0 Then '( attention avant le 0 ajouter un chevron ">")
      FichierExiste = True
   Else
      FichierExiste = False
   End If
End Function

Code:

1
2
3
Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
 
End Sub

19/03/2020, 09h46
Patrice740

Bonjour

Citation:

Envoyé par papy_polo67

Voila les codes ...

Merci de modifier ton post avec les balises CODE :
https://www.developpez.net/forums/d3...-balises-code/
http://club.developpez.com/aidenouve...es/Balises.gif
19/03/2020, 09h54
papy_polo67

Affichage de la version

j'ai bien lu qu'il fallait afficher la version de Excel, mais comment le faire?
Pour ma part c'est 2019
Merci

Citation:
Et le code qui devrait vider les cases mais qui apparemment ne fonctionne pas
Code:

1 2 3 4 5 6 7 8 Public Function FichierExiste(MonFichier As String) If Len(Dir(MonFichier)) > 0 Then '( attention avant le 0 ajouter un chevron ">") FichierExiste = True Else FichierExiste = False End If End Function
Attention, ici tu utilises une "Function" et pas un "Sub. Voici 2 tutos :

Explication sur Sub et Function
Explication détaillée sur les Function

Function ne permet pas de "faire quelque chose",mais retourne une valeur.
Ici, dans ton code par exemple, il retourne VRAI si Len(Dir(MonFichier)) > 0, FAUX sinon. Càd, il retourne VRAI si le nom du fichier existe, FAUX sinon. En aucun cas le code vide des cases.

Citation:

j'ai bien lu qu'il fallait afficher la version de Excel, mais comment le faire?
Pour ma part c'est 2019

Quand tu créés la discussion, il y a une liste déroulante où tu peux choisir la version d'Excel. Pour la prochaine fois ;)

ok, en fait cela n'a pas trop d'importance dans mon module.
Ce qui me préoccupe le plus c'est ou insérer un code pour que le ratio s'applique à la taille de l'image afficher en Image1 et Image2
Code pour Image 1

Code:

1
2
3
4
5
6
7
8
9
Option Explicit
Sub AfficheImage()
    With Sheets("Reines")
        On Error Resume Next
        .Shapes("Image1").Delete
        On Error GoTo 0
        If Dir(.Range("A1").Text) <> "" Then place_l_image_dans .Range("G4:I18"), .Range("A1").Text       (((c'est la que je ne sais pas comment faire, ce code est valable pour une plage de cellule et non un UseForm)))
    End With
End Sub

'
'

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub place_l_image_dans(rng As Range, chemin As String, Optional nom As String = "MonFichier")
    Dim Ratio#, W#, H#
    With rng.Parent.Pictures.Insert(chemin)
        .Name = nom
        .ShapeRange.LockAspectRatio = msoTrue    ' lock le ratio indéformable
        Ratio = .Width / .Height     ' calcul ratio de l' image
        W = rng.Width       ' width  range
        H = rng.Height      ' height range
        '--------------------------------------------------------------------------------------------
        '((((((on a bloqué l'aspect ratio on ne redimensionnera qu'un axe  le width ou le height!!!))))
        '--------------------------------------------------------------------------------------------
        If (W / H < Ratio) Then    'si ratio (rng) < que ratio image alors
            .Width = W - 2    'width image=width rng
        Else 'sinon
            .Height = H - (2 / Ratio)    ' height image =height rng
        End If
        .Left = rng.Left + ((rng.Width - .Width) / 2)    'on centre horizontalement
        .Top = rng.Top + ((rng.Height - .Height) / 2)    ' on centre verticalement
        .Placement = 1
    End With
End Sub