Bonjour à tout le monde,
Je revient vers vous suite à un nouveau problème.
Comme indiqué dans le titre, il s'agit d'un problème de Gif dans mon Userform.
Je vous explique, J'ai fais un Userfom (excel) qui utilise une base de données Access.
Dans l'Userform, je rentre le code d'un article dans une TextBox, j'ai un bouton de validation qui ouvre Access et charge la base de données pour y récupérer des infos par rapport au code de la TextBox.
Comme le travail d'Access est caché, j'ai mis un message d'attente et ajouté un Gif.
Tout fonctionne correctement excepté le Gif. Quand je met uniquement le message et le Gif, c'est nickel. Mais dès que je rajoute la partie Access, on ne le voit plus.
Peux être aurez-vous une idée que je n'ai pas eu. 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
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80 Private Sub CommandButton_OK_Click() ' Permet d'afficher un GIF pendant le chargement de la nomenclature Dim Fs As Object Set Fs = CreateObject("Scripting.FileSystemObject") 'Supprime l'image temporaire si elle existe If Fs.FileExists(ThisWorkbook.Path & "\imageTemp.gif") Then Kill ThisWorkbook.Path & "\imageTemp.gif" End If Dim i As Long, k As Long, P As Long, F As Long Dim Hauteur As Long, Largeur As Long Dim S As String Dim j As Integer Dim B() As Byte Dim Tb ' Indique l'étape du chargement Sommaire.Label113.Caption = "Accès à la base de données Access, en attente..." With ThisWorkbook.Worksheets("GIF").UsedRange Tb = .Value P = .Count End With ReDim Preserve B(1 To P) For i = 1 To UBound(Tb, 1) For j = 1 To UBound(Tb, 2) k = k + 1 B(k) = Tb(i, j) Next j Next i F = FreeFile S = ThisWorkbook.Path & "\imageTemp.gif" Open S For Binary Access Write As F Put #F, , B Close F With Sommaire.WebBrowser1 Largeur = .Width * 96 / 72 Hauteur = .Height * 96 / 72 .Navigate _ "ABOUT:<HTML><CENTER><HEAD><body scroll='no' LEFTMARGIN=0 TOPMARGIN=0><IMG WIDTH=" _ & Largeur & " HEIGHT=" & Hauteur & " SRC='" & S & _ "'</IMG></BODY></CENTER></HTML>" End With ' Pour l'extraction de la Nomenclature Const cAccesFichierBdD As String = "\Création Nomenclature.accdb" Dim vFichierDonnees As String Dim oAcApp As Object 'Access.Application Sheets("ARTICLE A VERIFIER").Range("I2") = Sommaire.TextBox_GPAO Sommaire.TextBox_GPAO = "" ' Lien sur le fichier de la base de données vFichierDonnees = ThisWorkbook.Worksheets("ARTICLE A VERIFIER").Range("J1") & cAccesFichierBdD Set oAcApp = CreateObject("Access.Application") oAcApp.Visible = True 'Ouvrir la base de données oAcApp.OpenCurrentDatabase vFichierDonnees 'Exécuter la macro oAcApp.Run ("Creation_BOM") 'Fermer la base de données oAcApp.CloseCurrentDatabase 'Libérer les ressources Set oAcApp = Nothing 'Supprime l'image temporaire si elle existe If Fs.FileExists(ThisWorkbook.Path & "\imageTemp.gif") Then Kill ThisWorkbook.Path & "\imageTemp.gif" End If End Sub
Partager