Aide sur WebBroser

Lone-wolf · 8 Septembre 2010

Bonjour à tous,

j'aimerais redimensionner webbroser par rapport aux gifs animés et, comment écrit-on la ligne pour inserer un gif différent.

Pour l'instant j'ai fait comme ceci:

Code:

Private Sub Ouvrir_Click()
Dim Fichier As String
Fichier = Application.GetOpenFilename("Fichiers GIF (*.GIF), *.GIF")
ChDrive "D"
ChDir ("D:\Dossiers Excel\VBA Excel\Gifs Animé\")
[COLOR="Red"][B]WebBrowser1.Navigate "about:<html><body scroll='no'>" & "<img src='D:\Dossiers Excel\VBA Excel\Gifs Animé\renne.gif'></img></body></html>"[/B][/COLOR]
End Sub

La ligne en rouge est à modifié.

PMO2 · 8 Septembre 2010

Re : Aide sur WebBroser

Bonjour,

Essayez avec votre code modifié

Code:

Private Sub Ouvrir_Click()
Dim Fichier As String
Fichier = Application.GetOpenFilename("Fichiers GIF (*.GIF), *.GIF")
UserForm1.WebBrowser1.Navigate "about:<html><body scroll='no'><img src='" & Fichier & "'></img></body></html>"
UserForm1.Show
End Sub

Cordialement.

PMO

Lone-wolf · 8 Septembre 2010

Re : Aide sur WebBroser

Bonsoir PMO2,

merci d'avoir répondu.

Mais il ne fallait pas enlever ChDrive et ChDir.

Voici le code, avec mise en pause de l'image.

Code:

Private Sub Arreter_Click()
WebBrowser1.Stop
End Sub

Private Sub Ouvrir_Click()
Dim Fichier As String
ChDrive "D"
ChDir ("Chemin du dossier\")
Fichier = Application.GetOpenFilename("Fichiers GIF (*.gif), *.gif")
UserForm1.WebBrowser1.Navigate "about:<html><body scroll='no'><img src='" & Fichier & "'></img></body></html>"
End Sub

Comme les gifs sont de formats différents, comment faire pour que webbroser s'adapte aux images?

Merci encore pour ton aide.

PMO2 · 9 Septembre 2010

Re : Aide sur WebBroser

Bonjour,

Essayez avec le code suivant (voir fichier joint qui est réalisé sous Excel 2003 car je n'ai pas Excel 2007))

Code:

Sub GifInWebBrowser()
Dim Fichier As Variant
Dim ShellApp As Object  'Shell32.Shell
Dim Dossier As Object   'Shell32.Folder
Dim ItemGif As Object   'Shell32.FolderItem
Dim A$
Dim Largeur
Dim Hauteur

''''ChDrive "D"
''''ChDir ("Chemin du dossier\")

Fichier = Application.GetOpenFilename("Fichiers GIF (*.GIF), *.GIF")
If Fichier = False Then Exit Sub
Set ShellApp = CreateObject("Shell.Application")
Set Dossier = ShellApp.Namespace(Mid(Fichier, 1, InStrRev(Fichier, "\") - 1))
A$ = Mid(Fichier, InStrRev(Fichier, "\") + 1)
For Each ItemGif In Dossier.Items
  If ItemGif.Name = A$ Then
    Hauteur = Dossier.GetDetailsOf(ItemGif, 28)
    Hauteur = CLng(Trim(Mid(Hauteur, 1, InStr(1, Hauteur, " ") - 1)))
    Largeur = Dossier.GetDetailsOf(ItemGif, 27)
    Largeur = CLng(Trim(Mid(Largeur, 1, InStr(1, Largeur, " ") - 1)))
    Exit For
  End If
Next ItemGif
Set Dossier = Nothing
Set ShellApp = Nothing
With UserForm1
  With .WebBrowser1
     .Navigate "about:<html><body scroll='no'><img src='" & Fichier & "'></img></body></html>"
    .Top = 0
    .Left = 0
    .Height = Hauteur
    .Width = Largeur
  End With
      '/// Pour ajuster éventuellement le UserForm à la taille du WebBrowser ///
  .Height = .WebBrowser1.Height + 25
  .Width = .WebBrowser1.Width
      '////////////////////////////////////////////////////////////////////////
  .Show
End With
End Sub

Cordialement.

PMO
Patrick Morange

Lone-wolf · 10 Septembre 2010

Re : Aide sur WebBroser

Bonjour PMO,

j'ai réussi à obtenir les effets souhaités, mise à part la transparence de webbroser.

Regarde sur ce fil: Gifs animés

On peut aussi créer celui-ci sans le mettre directement dans le formulaire et sans ActiveX.

Voir ce lien: Ce lien n'existe plus

Cordialement

Aide sur WebBroser

Lone-wolf

XLDnaute Barbatruc

PMO2

XLDnaute Accro

Lone-wolf

XLDnaute Barbatruc

PMO2

XLDnaute Accro

Lone-wolf

XLDnaute Barbatruc

Discussions similaires

Aide sur WebBroser

Lone-wolf

XLDnaute Barbatruc

PMO2

XLDnaute Accro

Lone-wolf

XLDnaute Barbatruc

PMO2

XLDnaute Accro

Lone-wolf

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency