XL 2016 Webcam pour une photo type carte identité

fanch55

XLDnaute Barbatruc
Salut à tous, mais cela est dirigé vers PatrickToulon dont je suis pas mal de fils intéressants (partout) et dont je me suis inspiré pour cette source .
Je joint contrairement à mon habitude un fichier complet en XLSM ( gare aux autorisations, mais je le certifie sans malveillance aucune [ de ma part] ) .
Ce fichier effectue une capture photo à partir de la webcam ( ou un fichier image ) et le réduit/redimensionne au format carte identité ou tout au moins aux dimensions 3.5 cm x 4.5 cm .
La partie intéressante est de transformer la photo rognée en une image conforme au but, c'est à dire de ne pas conserver l'image originale trop volumineuse .
Le besoin est de pouvoir fournir une photo de faible dimension au format CI pour des licences de pétanques (entre autre)
Tout point d'amélioration est le bienvenue .
Pour ceux qui n'ont pas de webcam sur le poste fixe, j'ai testé avec Droidcam sur le smartphone et Droidcam Client sur Pc, c'est opérationnel (j'en suis bluffé).
 

Pièces jointes

  • Camera.xlsm
    107.9 KB · Affichages: 84

patricktoulon

XLDnaute Barbatruc
re
voila la base de mon projet je met au propre pour l'instant
demo3.gif



je travaill a l'echelle bien entendu par exemple le fond d’écran pingouin ne rentrerais pas dans le userform

allez un autre pour la route
demo3.gif
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
oui je les ai lu ,tu veux que je te dise quoi
je t'ai seulement dit qu'il avait péché ca dans mon cam snapshot(ancienne version )
aujourd’hui et depuis un moment déjà j'utilise ma fonction magique
VB:
Function P_ToPx()
 With ActiveWindow.ActivePane
  P_ToPx = (.PointsToScreenPixelsY(cells.height) - .PointsToScreenPixelsY(0)) / cells.height
 End With
end function


après ,tout ce que j'ai utilisé dans ma démo userform cropseur d'image est niveau débutant sauf peu etre WIA et quoi que ;)
je n' utilise que des controls et des fonctions que toutes les versions d'excel ont a dispo

comme je disais au début de cette discussion il y a des outils pour ça même en VB(A)
 

fanch55

XLDnaute Barbatruc
Staple, en fait j'ai remis le code avec toutes ses évolutions ,( 32,64 bit, vba7 et win64) et quelques améliorations.
Bizarre, l'objet picture n'est plus proposé en natif, il faut passer par un Shape ou Object maintenant (Dim Img as Picture Shape )
 

fanch55

XLDnaute Barbatruc
Patrick, bien sûr que j'ai pompé des bouts de ton code pour la WebCam, je ne m'en suis pas caché.
Ce qui fonctionne, je ne vais pas le ré-inventer.
Intéressante ta fonction P_ToPx, cela évite de lire le registre, y-a-t-il une raison pour que ce soit une fonction ?
 

patricktoulon

XLDnaute Barbatruc
t'inqiet c'est pas la première fois que je constate des soucis avec
shapes.propriété ou shaperange.propriété avec des fichier 2016 sur mon 2007
en général je fait une copie trait pour trait dans un fichier 2007 et j'arrive a m'en sortir
mais non c'est pas la peine même la camera ne fonctionne plus pourtant le code qu'il a c'est le mien (tout du moins une partie) ;)

pour vous donner une idée de la simplicité du crop WIA
VB:
Private Sub CommandButton3_Click()
    Dim fname As Variant
    Dim Img As Object, IP As Object
    imgout = Application.GetSaveAsFilename(InitialFileName:=Environ("userprofile") & "\DeskTop", filefilter:="image Files (*.jpg), *.jpg", Title:="ENREGISTREMENT DE LA CAPTURE")

     Set Img = CreateObject("WIA.ImageFile")
     Set IP = CreateObject("WIA.ImageProcess")
      
      Img.LoadFile chemin.Value
    
    

    'on crops maintenant
    'Ajoute le filtre pour redimensionner l'image (Scale)
    IP.Filters.Add IP.FilterInfos("Crop").FilterID
    IP.Filters(1).Properties("Left") = (Img.Width / 100) * Val(cropleft)
    'definit la position à partir du bord supérieur pour la coupe
    IP.Filters(1).Properties("Top") = (Img.Height / 100) * Val(croptop)
    'definit la position à partir du bord droit pour la coupe
    IP.Filters(1).Properties("Right") = (Img.Width / 100) * Val(cropright)
    'definit la position à partir du bord inférieur pour la coupe
    IP.Filters(1).Properties("Bottom") = (Img.Height / 100) * Val(cropbottom)

    '----------------------------------------------------
    'etape finale
    'Application du filtre à l'image
    Set Img = IP.Apply(Img)
    'Enregistre l'image redimensionnée
If Dir(imgout) <> "" Then Kill imgout
    Img.SaveFile imgout
    Image1.PictureSizeMode = 0
    Image1.Picture = LoadPicture(imgout)
    cropsbutton_Click
End Sub
 

patricktoulon

XLDnaute Barbatruc
RE
Intéressante ta fonction P_ToPx, cela évite de lire le registre, y-a-t-il une raison pour que ce soit une fonction ?
non pas du tout perso je préfère comme ca je m'en sert partout en l’écrivant q'une fois c'est tout
ATTENTION TOUT DE MEME elle ne fonctionne pas si l'application est reduite dans le systray
normal les width et height des cellules font 0 et on tombe donc dans l'erreur division par zero

tu peux remplacer cells.height par 133 et tu n'a plus le soucis mais c'est moins precis a 7 chiffre apres la virgule
 

Statistiques des forums

Discussions
311 720
Messages
2 081 885
Membres
101 830
dernier inscrit
sonia poulaert