Discussion :

[SilkyRoad]

bonsoir

ceci est un essai pour utiliser le sous forum "Vos contributions VBA "


Utiliser la librairie Windows Image Acquisition Automation Library v2.0 depuis Excel

WIA est un composant très complet qui permet de manipuler les images.
Les informations et exemples suivants sont en partie issus des samples VB6 fournis lors du téléchargement de la librairie WIA (wiaaut.dll)
et que j'ai essayé d'adapter pour une utilisation depuis Excel

Les propriétés générales du WIA :
Accéder aux propriétés d’un fichier image.
Lire et écrire les fichiers image et leurs propriétés dans une base de données.
Manipuler les images : Rotation, Retournement, Décomposition des frames d'une image(par exemple d'un GIF animé) ...
Modifier les pixels incluant les valeurs alpha.
Gérer les Images prises par une webCam.
Visualiser les images des webCam connectées à votre PC.

La Bibliothèque WIA est principalement conçue pour gérer les formats d'image PNG, BMP, JPG, GIF et TIFF .
Les autres formats sont à tester en fonction de votre système d'exploitation.

Téléchargez la librairie si elle n'est pas installée sur votre poste :

http://www.microsoft.com/downloads/d...DisplayLang=en

Puis suivez les conseils d'installation fournis dans le fichier d'aide ReadMe.txt

Configuration minimale : Windows XP
Les exemples ci dessous ont été Testés avec WinXP et Excel2002




Un exemple pour gérer les images (voir le classeur en pièce jointe WIA_Image_Excel.xls)

Choisir une image sur le PC et l'afficher dans un Userform
Appliquer une rotation à 90 , 180 ou 270°
Appliquer un retournement Vertical ou Horizontal
Décomposer les frames d'une image (par exemple d'un GIF animé)
Créer une miniature dans l'image (Stamp)
Afficher les propriétés détaillées de l'image
Sauvegarder l'image modifiée




Vérifier si un fichier GIF est de type animé ou standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub controleFormatImageGIF()
Dim objImage As Object
Set objImage = CreateObject("WIA.ImageFile")
objImage.LoadFile ("C:\fichierImage.gif")
If objImage.IsAnimated Then
MsgBox "Gif animé"
Else
MsgBox "Gif standard"
End If
End Sub

Comment utiliser les filtres

Le lien sur le site Microsoft
http://msdn.microsoft.com/library/de...usefilters.asp


En complément voici une macro qui permet d'afficher une description de tous les filtres utilisés dans WIA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub listerInformationsGeneralesFiltres()
Dim x As Integer
Dim IP As ImageProcess
 
Set IP = CreateObject("WIA.ImageProcess")
 
For x = 1 To IP.FilterInfos.Count
Debug.Print "--> " & IP.FilterInfos(x).Name & ":"
Debug.Print IP.FilterInfos(x).Description
Debug.Print vbCrLf & "******************" & vbCrLf & vbCrLf
Next x
End Sub

Redimensionner une image

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
Sub redimensionnerImage()
Dim Img As Object, IP As Object
 
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
 
Img.LoadFile "C:\Documents and Settings\michel\dossier\fourmiz.JPG"
 
IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = 90
IP.Filters(1).Properties("MaximumHeight") = 90
 
Set Img = IP.Apply(Img)
Img.SaveFile "C:\Documents and Settings\michel\dossier\fourmizThumbnail.JPG"
End Sub

Combiner deux images

Remarque pour cet exemple :
Les dimensions de la 2eme image doivent etre plus petites que la premiere afin que celle ci ne soit pas totalement masquée .

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
Sub combinerDeuxImages()
Dim Img1 As Object, Img2 As Object, IP As Object
 
Set Img1 = CreateObject("WIA.ImageFile")
Set Img2 = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
 
Img1.LoadFile ("C:\Documents and Settings\michel\dossier\fourmiz.JPG")
' ! Remarque pour cet exemple :
'Les dimensions de la 2eme image doivent etre plus petites que la premiere afin
'que celle ci ne soit pas totalement masquée
Img2.LoadFile ("C:\Documents and Settings\michel\dossier\Mains.jpg")
 
IP.Filters.Add (IP.FilterInfos("Stamp").FilterID)
IP.Filters(1).Properties("ImageFile") = Img2
IP.Filters(1).Properties("Left") = Img1.Width - Img2.Width
IP.Filters(1).Properties("Top") = Img1.Height - Img2.Height
 
Set Img1 = IP.Apply(Img1)
'sauvegarde de la nouvelle image
Img1.SaveFile ("C:\resultat_Combinaison_Deux_images.jpg")
End Sub

Couper/Rogner une image

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
Sub couperImage()
Dim Img1 As Object, IP As Object
 
Set Img1 = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
 
Img1.LoadFile ("C:\Documents and Settings\michel\dossier\fourmiz.jpg")
 
IP.Filters.Add (IP.FilterInfos("Crop").FilterID)
IP.Filters(1).Properties("Left") = Img1.Width / 6
IP.Filters(1).Properties("Top") = Img1.Height / 6
IP.Filters(1).Properties("Right") = Img1.Width / 6
IP.Filters(1).Properties("Bottom") = Img1.Height / 6
Set Img1 = IP.Apply(Img1)
 
Img1.SaveFile ("C:\sauvegarde_Image_Coupee.jpg")
End Sub

Fusionner 2 images verticalement

'-------
'Cet exemple permet de créer une nouvelle image à partir de 2 images existantes :
'Les 2 images sont jointes bout à bout verticalement
'-------

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
Sub FusionVerticale_DeuxImages()
'Utilisation de la
'librairie Windows Image Acquisition Automation Library v2.0
'(à partir de Windows XP)
'
Dim Img1 As Object, Img2 As Object
Dim IP As ImageProcess
Dim Largeur As Long, Hauteur As Long
Dim V As Object, Img3 As Object
Dim C As Long
Dim i As Integer
 
Set Img1 = CreateObject("WIA.ImageFile")
Set Img2 = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
 
'l'image qui sera placée au dessus
Img1.LoadFile ("C:\Documents and Settings\michel\dossier\image01.JPG")
'l'image qui sera placée dessous
Img2.LoadFile ("C:\Documents and Settings\michel\dossier\image02.JPG")
 
 
'------ceation d'une image support pour fusionner les 2 images
    If Img1.Width > Img2.Width Then
        Largeur = Img1.Width
        Else
        Largeur = Img2.Width
    End If
 
    Hauteur = Img1.Height + Img2.Height
 
    C = &H80000004 'couleur de fond
    Set V = CreateObject("WIA.Vector")
 
    V.Add C
    V.Add C
    V.Add C
    V.Add C
 
    Set Img3 = V.ImageFile(2, 2)
    Set IP = CreateObject("WIA.ImageProcess")
    IP.Filters.Add IP.FilterInfos("Scale").FilterID
    IP.Filters(1).Properties("MaximumWidth") = Largeur
    IP.Filters(1).Properties("MaximumHeight") = Hauteur
    IP.Filters(1).Properties("PreserveAspectRatio") = False
    Set Img3 = IP.Apply(Img3)
'------------------
 
 
'réinitialisation des filtres
For i = 1 To IP.Filters.Count
IP.Filters.Remove i
Next i
 
'fusionner l'image1 dans le support
IP.Filters.Add (IP.FilterInfos("Stamp").FilterID)
IP.Filters(1).Properties("ImageFile") = Img1
IP.Filters(1).Properties("Left") = 0
IP.Filters(1).Properties("Top") = 0
 
Set Img3 = IP.Apply(Img3)
 
'fusionner l'image2 dans le support
IP.Filters(1).Properties("ImageFile") = Img2
IP.Filters(1).Properties("Left") = 0
IP.Filters(1).Properties("Top") = Img1.Height
 
Set Img3 = IP.Apply(Img3)
 
'sauvegarde de la nouvelle image
Img3.SaveFile ("C:\resultat_Fusion_Deux_images.jpg")
End Sub

Afficher les dimensions d'une image

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub dimensionsImage_V02()
Dim Img As Object
 
Set Img = CreateObject("WIA.ImageFile")
Img.LoadFile ("C:\Documents and Settings\michel\dossier\fourmiz.jpg")
 
MsgBox "Largeur = " & Img.Width & vbCrLf & _
    "Hauteur = " & Img.Height & vbCrLf & _
    "Resolution horizontale = " & Img.HorizontalResolution & vbCrLf & _
    "Resolution verticale = " & Img.VerticalResolution
End Sub

Gérer les Webcams (voir le classeur en pièce jointe: WIA_WebCam_Excel.xls)

Lister les Webcam connectées
Visualiser la Webcam
Mettre la caméra en pause
Afficher quelques informations
Effectuer une capture d'image
Enregistrer l'image capturée sur le PC

Votre WebCam doit etre préalablement branchée avant d'afficher l'UserForm
Remarque:
Vous pouvez brancher plusieurs WebCams simultanément et ensuite sélectionner dans le Treeview celle qui vous interesse



Plus généralement , pour utiliser la webCam dans un userForm , rien de plus simple :
Quand la librairie wiaaut.dll est installé sur votre poste,
Cherchez les objets DeviceManager Class et VideoPreview Class dans les controles supplémentaires de la boite à outils
insérez les 2 objets dans votre USF

et ensuite utilisez cette procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub UserForm_Initialize()
DeviceManager1.RegisterEvent wiaEventDeviceConnected
DeviceManager1.RegisterEvent wiaEventDeviceDisconnected
End Sub

Effectuer une capture d'image de la webCam

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
Dim Di As DeviceInfo
Dim Dev As Device
 
Private Sub UserForm_Initialize()
    DeviceManager1.RegisterEvent wiaEventDeviceConnected
    DeviceManager1.RegisterEvent wiaEventDeviceDisconnected
 
    '(1) correspond au premier objet connecté
    Set Di = DeviceManager1.DeviceInfos.Item(1)
    Set Dev = Di.Connect
 
    If Dev.Type = VideoDeviceType Then
    Set VideoPreview1.Device = Dev
    End If
End Sub
 
 
Private Sub CommandButton1_Click()
Dim Itm As Item
Dim Img As ImageFile
 
Set Itm = Dev.ExecuteCommand(wiaCommandTakePicture)
 
If Not Itm Is Nothing Then
    Set Img = Itm.Transfer
 
    If Not Img Is Nothing Then
    Set Image1.Picture = Img.FileData.Picture
    End If
End If
 
'pour enregistrer la capture sur le disque
'Img.SaveFile "C:\monimageTest_WIA_V02.jpg"
End Sub

bon week end
michel

[ThierryAIM]

ceci est un essai pour utiliser le sous forum "Vos contributions VBA "

Et bien, pour un essai
il ne me reste plus qu'à le transformer, si j'ai bien compris

ET qu'est-ce que ça va être, quand tu vas vraiment te mettre à rédiger des contributions

En tout cas Merci, j'ai pas encore tout digérer, mais ça viendra