Appliquer une image à tous les formulaires d'une base

[jpcheck]

Salut,

j'ai trouvé un petit bout de code qui permet de passer en revue tous les formulaires d'une base et d'y appliquer en image de fond l'image dont le path est passé en paramètre.

En espérant que cela sera utile pour certains

Code :

1
2
3
4
5
6
7
8
9
Sub GeneralizeImage(StrImagePath as String)
Dim tmpform As AccessObject
For Each tmpform In CurrentProject.AllForms
    DoCmd.OpenForm tmpform.Name, acDesign
    Forms(tmpform.Name).Picture = StrImagePath
    Forms(tmpform.Name).PictureSizeMode = 1
    DoCmd.Close acForm, tmpform.Name, acSaveYes
Next
End Sub

Exemple:

Code :

GeneralizeImage "C:\temp\monimagedefond.jpg"

[hajeahmad]

Bonjour

un autre bout de code dans le meme esprit que j'utilise (à adapter)
pour une base actuelle et base distante differente

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
 
Private Sub ChangerTous()
    Dim Obj As AccessObject
    For Each Obj In CurrentProject.AllForms
        If Obj.Name <> Me.Name Then
            DoCmd.OpenForm Obj.Name, acDesign  ', , , , acHidden
            Forms(Obj.Name).Picture = Me.Picture
            Forms(Obj.Name).PictureType = Me.PictureType
            Forms(Obj.Name).PictureSizeMode = Me.PictureSizeMode
            DoCmd.Close acForm, Obj.Name, acSaveYes
        End If
    Next Obj
End Sub
 
Private Sub Image7_Click()
    DbName = OpenFile(CurrentProject.Path, Mono_Sélection, True, MSOffice, 12, True)
    If IsNull(DbName) Or DbName = "" Then Exit Sub
 
    Dim acApp As Access.Application
    Set acApp = New Access.Application
    With acApp
        .Visible = True
        .OpenCurrentDatabase (DbName)
        For Each Obj In .CurrentProject.AllForms
            .DoCmd.OpenForm Obj.Name, acDesign, , , , acHidden
            .Forms(Obj.Name).Picture = Me.Picture
            .Forms(Obj.Name).PictureType = Me.PictureType
            .Forms(Obj.Name).PictureSizeMode = Me.PictureSizeMode
            .DoCmd.Close acForm, Obj.Name, acSaveYes
        Next Obj
        .Quit
    End With
    Set acApp = Nothing
End Sub

cordialement
ahmad