Discussion :

[patricktoulon]

Bonjour a tous
j'essai de convertir une png en gif avec WIA mais j'ai un message d'erreur que je ne saisi pas
j'ai beau chercher je ne trouve rien de concluant

une idé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
Sub transform2(chemin)
Dim Img 'As ImageFile
Set Img = CreateObject("WIA.ImageFile")
Img.LoadFile chemin
If Img.FormatID <> wiaFormatGIF Then
    Dim IP 'As New ImageProcess
    Set IP = CreateObject("Wia.ImageProcess")
 
    IP.Filters.Add IP.FilterInfos("Convert").FilterID
    IP.Filters(1).Properties("FormatID").Value = wiaFormatGIF
    Set Img = IP.Apply(Img)
Img.SaveFile ThisWorkbook.Path & "\copie.gif"
End If
End Sub

[Sebphyto]

Salut Patrick,
Bon après recherche, voici ce que j'ai trouvé, il faut déclarer des constantes de cette façon et après ça fonctionne, test à l'appui

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
' Miscellaneous
 
Const wiaIDUnknown = "{00000000-0000-0000-0000-000000000000}"
Const wiaAnyDeviceID = "*"
 
' FormatID
 
Const wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
 
' EventID
 
Const wiaEventDeviceConnected = "{A28BBADE-64B6-11D2-A231-00C04FA31809}"
Const wiaEventDeviceDisconnected = "{143E4E83-6497-11D2-A231-00C04FA31809}"
Const wiaEventItemCreated = "{4C8F4EF5-E14F-11D2-B326-00C04F68CE61}"
Const wiaEventItemDeleted = "{1D22A559-E14F-11D2-B326-00C04F68CE61}"
Const wiaEventScanImage = "{A6C5A715-8C6E-11D2-977A-0000F87A926F}"
Const wiaEventScanPrintImage = "{B441F425-8C6E-11D2-977A-0000F87A926F}"
Const wiaEventScanFaxImage = "{C00EB793-8C6E-11D2-977A-0000F87A926F}"
Const wiaEventScanOCRImage = "{9D095B89-37D6-4877-AFED-62A297DC6DBE}"
Const wiaEventScanEmailImage = "{C686DCEE-54F2-419E-9A27-2FC7F2E98F9E}"
Const wiaEventScanFilmImage = "{9B2B662C-6185-438C-B68B-E39EE25E71CB}"
Const wiaEventScanImage2 = "{FC4767C1-C8B3-48A2-9CFA-2E90CB3D3590}"
Const wiaEventScanImage3 = "{154E27BE-B617-4653-ACC5-0FD7BD4C65CE}"
Const wiaEventScanImage4 = "{A65B704A-7F3C-4447-A75D-8A26DFCA1FDF}"
 
' CommandID
 
Const wiaCommandSynchronize = "{9B26B7B2-ACAD-11D2-A093-00C04F72DC3C}"
Const wiaCommandTakePicture = "{AF933CAC-ACAD-11D2-A093-00C04F72DC3C}"
Const wiaCommandDeleteAllItems = "{E208C170-ACAD-11D2-A093-00C04F72DC3C}"
Const wiaCommandChangeDocument = "{04E725B0-ACAE-11D2-A093-00C04F72DC3C}"
Const wiaCommandUnloadDocument = "{1F3B3D8E-ACAE-11D2-A093-00C04F72DC3C}"
 
' WiaSubType enumeration
 
Const UnspecifiedSubType = 0
Const RangeSubType = 1
Const ListSubType = 2
Const FlagSubType = 3
 
' WiaDeviceType enumeration
 
Const UnspecifiedDeviceType = 0
Const ScannerDeviceType = 1
Const CameraDeviceType = 2
Const VideoDeviceType = 3
 
' WiaItemFlag enumeration
 
Const FreeItemFlag = &h0
Const ImageItemFlag = &h1
Const FileItemFlag = &h2
Const FolderItemFlag = &h4
Const RootItemFlag = &h8
Const AnalyzeItemFlag = &h10
Const AudioItemFlag = &h20
Const DeviceItemFlag = &h40
Const DeletedItemFlag = &h80
Const DisconnectedItemFlag = &h100
Const HPanoramaItemFlag = &h200
Const VPanoramaItemFlag = &h400
Const BurstItemFlag = &h800
Const StorageItemFlag = &h1000
Const TransferItemFlag = &h2000
Const GeneratedItemFlag = &h4000
Const HasAttachmentsItemFlag = &h8000
Const VideoItemFlag = &h10000
Const RemovedItemFlag = &h80000000
 
' WiaPropertyType enumeration
 
Const UnsupportedPropertyType = 0
Const BooleanPropertyType = 1
Const BytePropertyType = 2
Const IntegerPropertyType = 3
Const UnsignedIntegerPropertyType = 4
Const LongPropertyType = 5
Const UnsignedLongPropertyType = 6
Const ErrorCodePropertyType = 7
Const LargeIntegerPropertyType = 8
Const UnsignedLargeIntegerPropertyType = 9
Const SinglePropertyType = 10
Const DoublePropertyType = 11
Const CurrencyPropertyType = 12
Const DatePropertyType = 13
Const FileTimePropertyType = 14
Const ClassIDPropertyType = 15
Const StringPropertyType = 16
Const ObjectPropertyType = 17
Const HandlePropertyType = 18
Const VariantPropertyType = 19
Const VectorOfBooleansPropertyType = 101
Const VectorOfBytesPropertyType = 102
Const VectorOfIntegersPropertyType = 103
Const VectorOfUnsignedIntegersPropertyType = 104
Const VectorOfLongsPropertyType = 105
Const VectorOfUnsignedLongsPropertyType = 106
Const VectorOfErrorCodesPropertyType = 107
Const VectorOfLargeIntegersPropertyType = 108
Const VectorOfUnsignedLargeIntegersPropertyType = 109
Const VectorOfSinglesPropertyType = 110
Const VectorOfDoublesPropertyType = 111
Const VectorOfCurrenciesPropertyType = 112
Const VectorOfDatesPropertyType = 113
Const VectorOfFileTimesPropertyType = 114
Const VectorOfClassIDsPropertyType = 115
Const VectorOfStringsPropertyType = 116
Const VectorOfVariantsPropertyType = 119
 
' WiaImagePropertyType enumeration
 
Const UndefinedImagePropertyType = 1000
Const ByteImagePropertyType = 1001
Const StringImagePropertyType = 1002
Const UnsignedIntegerImagePropertyType = 1003
Const LongImagePropertyType = 1004
Const UnsignedLongImagePropertyType = 1005
Const RationalImagePropertyType = 1006
Const UnsignedRationalImagePropertyType = 1007
Const VectorOfUndefinedImagePropertyType = 1100
Const VectorOfBytesImagePropertyType = 1101
Const VectorOfUnsignedIntegersImagePropertyType = 1102
Const VectorOfLongsImagePropertyType = 1103
Const VectorOfUnsignedLongsImagePropertyType = 1104
Const VectorOfRationalsImagePropertyType = 1105
Const VectorOfUnsignedRationalsImagePropertyType = 1106
 
' WiaEventFlag enumeration
 
Const NotificationEvent = 1
Const ActionEvent = 2
 
' WiaImageIntent enumeration
 
Const UnspecifiedIntent = 0
Const ColorIntent = 1
Const GrayscaleIntent = 2
Const TextIntent = 4
 
' WiaImageBias enumeration
 
Const MinimizeSize = 65536
Const MaximizeQuality = 131072

Evidemment tu ne déclares que celle dont tu as besoin

ICI

Seb

[patricktoulon]

puré j'y crois pas c'est le bleu qui me met la patée
bien vu seb

[patricktoulon]

bon maintenant j'ai un autre soucis
la convertion transforme la transparence en blanc opaque et m'encadre en noir l image !!

[OlivYeah]

Bonjour à vous deux,

Je me suis également penché sur la petite colle de Patrick.

J'ai essayé cela qui fonctionne chez moi :

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 test_images2()
 
'Microsoft Windows Image Acquisition Library v2.0
 
 
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
 
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
 
Img.LoadFile "Tonchemin\banane.png"
 
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(1).Properties("FormatID").Value = wiaFormatGIF
IP.Filters(1).Properties("Quality").Value = 5
 
Set Img = IP.Apply(Img)
 
Img.SaveFile "TonChemin\banane_conversion.gif"
 
End Sub

Au plaisir

Cdt

[patricktoulon]

Bonjour OlivYeah
c'est exactement mon premier code qui ne fonctionne pas chez moi
tu tourne sur quoi comme system d'exploitation ??

[OlivYeah]

Patrick,

Oui exactement, c'est pour cela que j'étais un peu surpris.

Au premier essai j'avais le message d'erreur comme quoi l'ID était mal formaté.
J'ai uniquement ajouté la ligne relative à la qualité, tapé le chemin en dur et activé la référence.

Je t'avoue que je ne comprends pas trop ...

Je tourne sous Windows 7 Pro 64, SP1
Office 2013

Bien cordialement

Olivier

[Sebphyto]

Re,

puré j'y crois pas c'est le bleu qui me met la patée

bon bon ça va....

Chez moi pas de problème comme tu peux le voir.


Mais...je regarde s'il y a pas une autre propriété au cas où
seb

[patricktoulon]

et est ce que ca te vire la transparence aussi chez toi???

[patricktoulon]

Re,


bon bon ça va....

Chez moi pas de problème comme tu peux le voir.


Mais...je regarde s'il y a pas une autre propriété au cas où
seb

ok mais c'est bien que tu apporte un peu ton aide ca change
toi aussi essaie de convertir un png avec transparence pour voir

[patricktoulon]

bon en effet je viens de faire le teste il semblerait qu' en LateBinding tout ne soit pas pris en compte allez savoir !!!

donc même avec les variable en declaration tardives

Code :

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

1
2
3
4
Dim Img 'As object
Dim IP 'As object
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")

activez quand même la référence Microsoft Windows Image Aquisition version(X,Y)
et la!!.. même avec les constantes bloquées ca fonctionne

Merci OlivYeah c'est toi qui m'a mis la puce a l'oreille

bon maintenant toujour ce soucis de transparence

[OlivYeah]

Re à vous deux,

Patrick, j'ose te dire "de rien", du haut de ma petite contribution, vu le nombre de posts et de contributions laissés de ta part sur ce forum

Je suis aussi sur la transparence pour test.

[patricktoulon]

Bon j'ai déjà un peu avancer
en fait les bordures noires que l'on voit après conversion c'est les bords du calques en effet les png on toujour 2 calque au minimum
1 alpha
2 image

alors j'ai regarder un peu du coté des vector et j'arrive a supprimer ces gros trait noirs en remplacant la couleur des vector
si v(i)=0 then v(i)="&Hffffff"

c'est un peu long mais ca fonctionne je verrais si je peut faire ca avec une variable en byte

voila ca donne ca

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 transform(chemin)
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Dim v ' as vector
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile chemin
Set v = Img.ARGBData
For i = 1 To v.Count
    Debug.Print Hex(v(i))
    If v(i) = 0 Then v(i) = "&HFFFFFF" '&HFFFF00FF 'opaque pink (A=255,R=255,G=0,B=255)
Next
IP.Filters.Add IP.FilterInfos("ARGB").FilterID
 Set IP.Filters(1).Properties("ARGBData") = v
 
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID").Value = wiaFormatGIF
IP.Filters(2).Properties("Quality").Value = 10
Set Img = IP.Apply(Img)
Img.SaveFile ThisWorkbook.Path & "\BlissCompressed.gif"
 
End Sub

reste a transformer tout ce qui est en "&HFFFFFF" en transparent

alors avec gimp mon ami j'ai modifié volontairement un png

j'ai sélectionné tout ce qui était transparent et je l'ai peint en rose
ensuite j'ai gommer le rose (visuellement la transparence revient )
et j'ai exporté en png en gardant la couleur rose dans les meta données de l'image dans la fenêtre de dialogue de gimp
et bien après conversion par ma macro j'te l'donne dans le mille Emile, le fond est rose!!!
il y a donc bien suppression du canal ALPHA
voila si quelqu'un sait comment le réattribué ca m'arrangerais beaucoup

[Sebphyto]

Slt Patrick,

Je cherche, je cherche mais c compliqué, pas simple ton truc....
mise à part le # à mettre devant un code Hex, pour la transparence....
des choses peut-être intéressante ici

entre-deux: si tu veux jeter un coup d'œil sur mon sujet: ici

Désolé mais je bloque là

Seb

[patricktoulon]

re
ou tu a vu que le # c' était pour la transparence
pas en vba en tout cas en vba c'est "&H"

[Sebphyto]

Salut Patrick,

IL est où ton post où tu disais:

re bonsoir a tous
bon déjà je sais maintenant ou il faut chercher
c'est dans tes constantes qu'il y a un soucis
j'explique :
j'avais l'erreur" l'id n'est pas formaté correctement" parce que j'avais pas la référence activée
comme j'était en late binding (set my object=create.......) normalement ca n'est pas nécessaire mais bon passons allons y activons la

problème après conversion les vecteur de calque était transformé en pixel noir
je rentre donc du restaurant après un bon repas entre amis et je me suis dis que j'allais pas rester sur cet échec
je vais donc voir le lien seb a donné et je teste je connaissais bref toujours pas de transparence mais on peut changer la couleur des vecteurs (intéressant pour plus tard )


bref je ferme tout et ouvre un classeur vierge et met cette macro dans un module en activant la référence
et la!!!!!!!!!!! surprise tout est bon !!!!
je me dis qu'il y a quelque chose que j'ai pas vu dans mon autre code
je regarde les différences il n'y en a pas a part les constantes
que cela te tienne dans le code qui fonctionne j'ajoute les déclarations des constantes
et la buh....!!!! les vecteurs sont a nouveau transformé en noir
résultat des course il y a une constantes qui n'est pas bonne
il va falloir chercher

ou tu a vu que le # c' était pour la transparence
pas en vba en tout cas en vba c'est "&H"

j'avais vu çà sur un autre site mais rien à voir avec VBA...Désolé

Seb

[Sebphyto]

Voici ce que j'ai trouvé

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
Option Explicit
 
' Declaration order of bytes important because of how a long is held in PC memory
Private Type ARGB
    Blue As Byte
    Green As Byte
    Red As Byte
    Alpha As Byte
End Type
 
Private Type udtLong
    l As Long
End Type
 
Public Sub example()
    Dim Filter As ARGB
    Dim WIAFilter As udtLong
 
    ' Convert an ARGB long into component parts
    WIAFilter.l = &HFF001234
    LSet Filter = WIAFilter
    MsgBox "Alpha: " & Filter.Alpha & " Red: " & Filter.Red & " Green: " & Filter.Green & " Blue: " & Filter.Blue
 
    'Convert component parts into ARGB long
    With Filter
        .Alpha = 17
        .Red = 127
        .Green = 37
        .Blue = 100
    End With
    LSet WIAFilter = Filter
    MsgBox "ARGB: " & Hex(WIAFilter.l)
 
End Sub

seb

[patricktoulon]

Bonjour Seb
oui le message je l'ai supprimé c'était faux j'avais oublier les 2 ligne convert

donc case départ en code simple en activant la référence j'ai le même résultat

ca m'a l'air intéressant ce que tu propose convertir les 4 données en hex

je vais regarder
après ca m'ennuie un peu je t'explique pour quoi:

les png avec transparence on le fond en couleur en fait qui est en opacity 0 mais le soucis c'est que certaines sont noires d'autre sont blanche d'autre sont magenta etc....

alors en fait il me faudrait un peu l'inverse
récupérer chaque vecteur le décanter pour avoir le rgb et le Alpha pour que je puisse le reconstituer dans le gif

mais ton ID est bonne c'est ce que je dissais plus haut se servir d'une variable en byte pour les argb

le soucis pour moi c'est de partir du hex "comment savoir quelle valeur attribuer au alpha dans le hex "

en fait si tu trouve comment créer une image vide avec WIA ca m'intéresse
je pense avoir une idée

[OlivYeah]

Bonjour Patrick, Sebphyto,

Je ne sais pas si cela répond exactement à ta demande. (Trouvé sur le MSDN)
Création d'une image vide (Hexa à adapter selon tes besoins)

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
 
 
Sub Creer_Image_vide()
 
Dim v 'As Vector
Dim Img 'As ImageFile
Dim c 'As Long
 
    c = &HFF0000FF 'opaque blue (A=255,R=0,G=0,B=255)
    Set v = CreateObject("WIA.Vector")
 
        v.Add c
        v.Add c
        v.Add c
        v.Add c
 
    Set Img = v.ImageFile(2, 2)
 
    Img.SaveFile "TonCheminDeSortie\Blue." & Img.FileExtension
 
End Sub

Olivier

[patricktoulon]

Bonjour OlivYeah

oui plus ou moins cela me permet en tout cas de déterminer une couleur complètement transparente

mais ca change rien
meme avec le A a 255 ou 0 l'image les parties transparentes restent blanches

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
Sub transform(chemin)
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Dim v ' as vector
Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Img.LoadFile chemin
Set v = Img.ARGBData
For i = 1 To v.Count
    vX = Hex(v(i))
    If v(i) = 0 Then v(i) = "&H00FFFFFF" 'A à 0 et blanc (A=0,R=255,G=255,B=255)
'"&HFFFFFFFF" 'A à 255 et blanc (A=255,R=255,G=255,B=255)
'
'Debug.Print vX & "---  " & Hex(v(i))
Next
IP.Filters.Add IP.FilterInfos("ARGB").FilterID
 Set IP.Filters(1).Properties("ARGBData") = v
 
IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters(2).Properties("FormatID").Value = wiaFormatGIF
IP.Filters(2).Properties("Quality").Value = 5
Set Img = IP.Apply(Img)
Img.SaveFile ThisWorkbook.Path & "\temp2.gif"
 
End Sub

il y a bien un soucis a partir de convert qui ne garde pas le canal alpha

tout les vecteur de calque sont bien remplacés par du blanc mais pas de transparence
résultat avec 0 ou 255 pour A