You are here:---Rispondi a: [RISOLTO] Problema Image Control
Rispondi a: [RISOLTO] Problema Image Control2017-11-26T16:08:45+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Problema Image Control Rispondi a: [RISOLTO] Problema Image Control

AvatarFedtorrent
Partecipante
    Post totali: 6

    Ciao Sal,
    allora ho risolto aggirando il problema e seguendo il tuo metodo “drastico”. :wacko:
    Leggendo questo articolo https://analysistabs.com/vba-code/excel-userform/image/#bm5 ho capito che i controlli immagine si possono cancellare dalla Userform solo se si creano dal VBA.
    Ho quindi creato una sub che crea le 8 immagini (thumbnails) vuote da richiamare quando serve:

    Sub CreaThumbs()
    Dim PosTop As Integer, PosLeft As Integer, Immagine(8) As Object, X As Integer
    'Crea i controlli immagine
    
    PosTop = 150
    PosLeft = 24
    
    For X = 1 To 8
        Set Immagine(X) = Me.Controls.Add("Forms.Image.1")
        With Immagine(X)
            .Top = PosTop
            .Left = PosLeft
            .Height = 84
            .Width = 78
            .BorderStyle = 1
            .PictureSizeMode = 3
            .Enabled = True
            .Picture = LoadPicture(ActiveWorkbook.Path & "\Immagini Accessori\No-image-available.jpg")
            .Name = "Image" & X
        End With
        If X < 4 Then PosLeft = PosLeft + 100
        If X = 4 Then PosLeft = 24: PosTop = 258
        If X > 4 Then PosLeft = PosLeft + 100
    Next X
    
    End Sub

    Poi ho creato una seconda sub per eliminarli e ricrearli:

    Sub ResetMaschera()
    Dim X As Integer, Y As Integer
    
    For X = 1 To 8
        Me.Controls.Remove ("Image" & X)
    Next X
    
    'Ricrea i controlli immagine
    CreaThumbs
    
    End Sub

    Infine, per far si che al passaggio del mouse sopra ingrandisse l’immagine nel controllo dedicato ho usato l’evento Userform.MouseMove delimitando le aree delle immagini :

    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim PosX As Single, PosY As Single
    
    PosX = X
    PosY = Y
    
    If PosY > 145 And PosY < 240 Then
        If PosX > 20 And PosX < 110 Then
            Image0.Picture = Me.Controls("Image1").Picture
        End If
        If PosX > 120 And PosX < 210 Then
            Image0.Picture = Me.Controls("Image2").Picture
        End If
        If PosX > 220 And PosX < 310 Then
            Image0.Picture = Me.Controls("Image3").Picture
        End If
        If PosX > 320 And PosX < 410 Then
            Image0.Picture = Me.Controls("Image4").Picture
        End If
    End If
    
    If PosY > 250 And PosY < 340 Then
        If PosX > 20 And PosX < 110 Then
            Image0.Picture = Me.Controls("Image5").Picture
        End If
        If PosX > 120 And PosX < 210 Then
            Image0.Picture = Me.Controls("Image6").Picture
        End If
        If PosX > 220 And PosX < 310 Then
            Image0.Picture = Me.Controls("Image7").Picture
        End If
        If PosX > 320 And PosX < 410 Then
            Image0.Picture = Me.Controls("Image8").Picture
        End If
    End If
    
    End Sub

    Tutto sommato sono abbastanza soddisfatto del risultato :yahoo:

    …Fedtorrent

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi