XL 2016 Webcam pour une photo type carte identité

fanch55 · 11 Février 2020

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é).

patricktoulon · 14 Février 2020

@Staple1600 😀 😀 😀 😀 😕 😕 😕 😕 😛 😛 😛

annonce:
cherche ame charitable pouvant me donner des cours de français, j'ai peur que l'on ne me comprenne plus

Usine à gaz · 20 Février 2020

Bonjour Patrick, le Forum,

Merci pour ton formidable travail et surtout te tenacité 🙂
J'ai suivi tous les fils et c'est tellement intéressant !

J'ai téléchargé ton fichier mais chez moi ça beug ici :
Private Sub CommandButton2_Click()
Dim filetoopen As Variant, ratio, sizeimg, coeff#
ChDir "C:\Users\Public\Pictures\Sample Pictures"

Bonne journée à toi et à toutes et à tous,
Amicalement,
lionel 🙂

patricktoulon · 20 Février 2020

arthour973 à dit:
Bonjour Patrick, le Forum,

Merci pour ton formidable travail et surtout te tenacité 🙂
J'ai suivi tous les fils et c'est tellement intéressant !

J'ai téléchargé ton fichier mais chez moi ça beug ici :
Private Sub CommandButton2_Click()
Dim filetoopen As Variant, ratio, sizeimg, coeff#
ChDir "C:\Users\Public\Pictures\Sample Pictures"

Bonne journée à toi et à toutes et à tous,
Amicalement,
lionel 🙂

bonjour a tous
@arthour973 enlève le ça ne t'est pas utile c’était juste pour positionner le dialog sur le dossier d'image window

@MJ13 non c'est pas ca du tout
en fait le crop se fait sur le pictureformat du shaperange d'une picture
et il se fait en se basant sur le WIDTH ORIGINAL! et le HEIGHT ORIGINAL! ET surtout en pourcentage et non en point ou cm ou pixel
j'ai cravaché comme un âne pour le comprendre avec des calculs ramenant a size original
et quand j'ai trouvé ma formule j'ai cherché dans ce sens sur le net et j'ai trouvé tout de suite
comme quoi quand on sait pas 😳 😳 😳 😳 😛

@tous
en fait franch55 et moi avions tout faux quand au calcul a opérer c'est pour cela que l'on trouvait pas de logique
le crop doit se faire comme suit
'Crop-->(Left,Top,Right,Bottom) = original Size(width ou height) * pourcentage / 100
exemple
.cropLeft =1024*50/100
'les 1024 étant le width d'origine!!!!!!!! ((((meme si elle a été redimentionnée)))) ce qui nous donne une image coupé a gauche de 50%
quand je pense que je me suis pris la tète😕😳🙄

nous voila donc avec ma version 2.0 sur feuille qui opère de cette façon et le résultat est parfait

elle est belle ma demo 😛

pffffiu puré!!!!
képrizdetete!!!

bon maintenant je vais regarder ce qu'a fait MJ13
un fichier aurait été bien venu 😉

patricktoulon · 20 Février 2020

re
@MJ13
bon j'ai testé et c'est pas bon du tout du tout

mais effectivement il y a une autre solution avec un chart, mais t'en est loin c'est beaucoup plus simple que ca 😉

MJ13 · 20 Février 2020

Re Patrick

Tu as raison, cela ne fonctionne pas avec tout types d'images, juste avec celle qui font 2048 de large, c’était mon besoin au départ.

Il y a quand même des choses bizarres qui me dépassent avec le traitement d'images sur Excel. 🙂

patricktoulon · 20 Février 2020

re
bizarre non il suffit de connaître la formule qui est assez simple en fait
contrairement a beaucoup dans excel ici on exprime un calcul en % et le prorata se fait en interne par rapport aux dims actuelles par aux dims d'origines

eu t il fallu que je le susse 😛 😉 la version 2.0 est nickel tu peux tester
et voici la version 2.1 avec tout simplement le bouton pour enregistrer la coupe

fanch55 · 20 Février 2020

Crops sur feuille :
modifié le code comme ci-dessous :

VB:

Sub crop_with_calque() 'fonction de coupage
    Dim P_ToPx&, Calque As Shape, L#, R#, T#, B#
    Dim Origin As Shape, RH#, RT#, RL#, RW#
    Set Calque = Me.Shapes("calque")
    Set Origin = Me.Shapes("origin")
    'Application.CommandBars.ExecuteMso ("PictureCrop")' pas vraiment besoins
    With Origin
        RH = Calque.Height / Origin.Height              ' rapport hauteur calque/ hauteur image
        RW = Calque.Width / Origin.Width                ' rapport largeur calque/ largeur image
        RT = (Calque.Top - Origin.Top) / Origin.Height  ' rapport top calque/ top image
        RL = (Calque.Left - Origin.Left) / Origin.Width ' rapport left calque/ left image
        .ScaleWidth 1, True       ' indispensable pour travailler sur les dimensions réelles
        .ScaleHeight 1, True      'indispensable pour travailler sur les dimensions réelles
        With Calque
            .Height = Origin.Height * RH
            .Width = Origin.Width * RW
            .Top = Origin.Top + Origin.Height * RT
            .Left = Origin.Left + Origin.Width * RL
        End With
        With .PictureFormat
            L = Calque.Left - Origin.Left
            R = Origin.Width - (L + Calque.Width)
            T = Calque.Top - Origin.Top
            B = Origin.Height - (T + Calque.Height)
            .CropTop = T
            .CropBottom = B
            .CropLeft = L
            .CropRight = R
        End With
        .Height = [d3:d12].Height: .Left = [d3].Left + ([d3:f3].Width - .Width) / 2: .Top = [d3].Top
    End With
    With Calque: .ZOrder msoBringToFront: .Top = [c2].Top: .Left = [c2].Left: .Width = 1: .Height = 1: End With
    CommandButton2.Enabled = False: CommandButton3.Enabled = False: CommandButton4.Enabled = False
    [d3:F11].Select
End Sub

Ca a l'air de fonctionner, à moins que qqchose m'ait échappé ..

fanch55 · 20 Février 2020

Mince, je suis en retard sur le fil, je vais tester ta nouvelle version Patrick,
mais c'est dommage que tu ne vois pas le crop natif d'excel 2016 ( à partir de 2010 ) .. 😉

patricktoulon · 20 Février 2020

re
bonsoir franch55 oui j'ai pas tester mais ça a l'air d’être ça en fait ça se fait comme je le fait dans mon userform (en pourcentage)
tes formule sont simplifiée je testerais tout a l'heure

ça fonctionne sinon chez toi non?avec crpLeft et non crop.ShapeLeft etc ....

patricktoulon · 20 Février 2020

fanch55 à dit:
Mince, je suis en retard sur le fil, je vais tester ta nouvelle version Patrick,
mais c'est dommage que tu ne vois pas le crop natif d'excel 2016 ( à partir de 2010 ) .. 😉

tu peux y aller c'est propre normalement 😉
l'essentiel c'est que l'on partage une version qui fonctionne chez tout le monde non ?😉

patricktoulon · 20 Février 2020

re
hahagrrrrr!!!!!
le crop est bon mais tu n'est pas a la bonne échelle
avec le mien la photo fait vraiment 3.5 par 4.5 échelle(calculée direct) a la sortie
la tienne fait 7.2 par 5.6 a l'echelle 55
la tienne

la mienne

fanch55 · 20 Février 2020

Crop image sur feuille V 2.1 :

Brut de décoffrage:
Tout bon, mais souffre de qq défauts :
On tombe aléatoirement (je n'ai pas vraiment déterminé le quand et pourquoi ) sur une division par zéro , mais particulièrement quand l'image originale est plus petite que le calque

Sinon, j'ai été confronté à une image sauvegardée dans une taille ne correspondant pas à la taille CI, mais j'ai été incapable de le reproduire .... je vais creuser
En tout cas c'est plus "agréable" à manipuler que le crop natif ... mais ça nécessite plus de calculs ...😛

Pour le code que je t'ai soumis :
Si tu l'as laissé tel quel, c'est normal, puisque l'image a été "resizée" pour visu à la ligne ci-dessous en gras :

....
....
End With
.Height = [d3:d12].Height: .Left = [d3].Left + ([d3:f3].Width - .Width) / 2: .Top = [d3].Top
End With
With Calque: .ZOrder msoBringToFront: .Top = [c2].Top: .Left = [c2].Left: .Width = 1: .Height = 1: End With
CommandButton2.Enabled = False: CommandButton3.Enabled = False: CommandButton4.Enabled = False
[d3:F11].Select
End Sub

patricktoulon · 21 Février 2020

On tombe aléatoirement (je n'ai pas vraiment déterminé le quand et pourquoi ) sur une division par zéro , mais particulièrement quand l'image originale est plus petite que le calque

ha oui ça j'y ai pas pensé
je vais faire la même chose que le userform
1 peut pas sortir du cadre de l'image et pas plus grand sous la forme d'un avertissement

bon je n'arrive pas a tomber sur division by zero mais en effet quand le calque sort du cadre de limage le crop coupe bien les bords interieurs dans l'image mais crée les reste en transparent
démonstration

il va falloir donc corriger ce point
j'ai deja mon idée le faire en silencieux lors du click sur crop 😉

ps: ca yest j'ai trouvé l'erreur "division by zero" c'est quand cote de l'un est egal a l'autre
exemple
percentLeft = 100 / (pict.Width / (Calque.Left - pict.Left )) si les deux left sont identique on est dedans

patricktoulon · 21 Février 2020

re
et voila c'est corrigé

VB:

Sub crop_with_calque()    'fonction de coupage
    Dim percentLeft#, percentTop#, percentRight#, percentBottom#, origWidth#, origHeight#, pict As Picture, Calque As Shape
    Dim temp
    Set pict = ActiveSheet.Pictures("origin"): Set Calque = ActiveSheet.Shapes("calque")

    '******************************************
    'correctif  depassement du calque si un de ses bord est en dhors de l'image
    If Calque.Left < pict.Left Then temp = pict.Left - Calque.Left: Calque.Left = pict.Left: Calque.Width = Calque.Width - temp

    If Calque.Top < pict.Top Then temp = pict.Top - Calque.Top: Calque.Top = pict.Top: Calque.Height = Calque.Height - temp

    If Calque.Left + Calque.Width > (pict.Left + pict.Width) Then
        Calque.Width = Calque.Width - ((Calque.Left + Calque.Width) - (pict.Left + pict.Width))
    End If

    If Calque.Top + Calque.Height > (pict.Top + pict.Height) Then
        Calque.Height = Calque.Height - ((Calque.Top + Calque.Height) - (pict.Top + pict.Height))
    End If
    '***********************************************
    'correctif "divizion by zero" coome ca
    If Calque.Left - pict.Left > 0 Then percentLeft = 100 / (pict.Width / (Calque.Left - pict.Left)) Else percentLeft = 0
    If Calque.Top - pict.Top > 0 Then percentTop = 100 / (pict.Height / (Calque.Top - pict.Top)) Else percentTop = 0

    'ou comme ca
    percentRight = 100 - (100 / (pict.Width / (Application.Max((1 / 100000000000#), Calque.Left - pict.Left) + Calque.Width)))
    percentBottom = 100 - (100 / (pict.Height / (Application.Max((1 / 100000000000#), Calque.Top - pict.Top) + Calque.Height)))


    With pict.ShapeRange    '(1)
        'on fait une copie temporaire pour récupérer les dimention originales!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        With .Duplicate: .ScaleWidth 1, True: origWidth = .Width: origHeight = .Height: .Delete: End With
        With .PictureFormat
            'Crop-->(Left,Top,Right,Bottom) = original Size(width ou height) * pourcentage / 100
            .CropLeft = origWidth * (percentLeft / 100)
            .CropRight = origWidth * (percentRight / 100)
            .CropTop = origHeight * (percentTop / 100)
            .CropBottom = origHeight * (percentBottom / 100)
        End With
        .Left = (([d3:F11].Width - .Width) / 2) + [d3:F11].Left
        .Top = (([d3:F11].Height - .Height) / 2) + [d3:F11].Top
    End With
    With Feuil1.Shapes("calque"): .ZOrder msoBringToFront: .Top = [c2].Top: .Left = [c2].Left: .Width = 1: .Height = 1: End With
    Feuil1.CommandButton2.Enabled = False: Feuil1.CommandButton3.Enabled = False: Feuil1.CommandButton4.Enabled = False
    Feuil1.CommandButton5.Enabled = True
    [d3:F11].Select
End Sub

fanch55 · 11 Mars 2020

Re-salut à tous,
Un petit aparté pour info :
le chart.export est assez destructif pour toutes les informations d'une photo :

Bref, il faudra rejouer avec WIA pour sauvegarder les infos et les restaurer .... 😡

XL 2016 Webcam pour une photo type carte identité

fanch55

XLDnaute Barbatruc

Pièces jointes

patricktoulon

Usine à gaz

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

MJ13

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

XL 2016 Webcam pour une photo type carte identité

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Privacy & Transparency

Privacy & Transparency