Utiliser une Pen Tablet sur Excel Résolu/Fermé

Question

Bonjour,
j'ai une Pen Tablet sur laquelle je peux faire une signature à l'aide du stylet.
Cette signature apparaît à l'écran - jusque là, ça va !
Je voudrais par VBA faire en sorte que ma signature se rétrécisse afin d'entrer dans une case définie.
Et ensuite que cette signature (ce dessin en fait) aille se placer à un endroit bien précis de ma feuille Excel.
et après enregistrement, effacement de la signature pour faire place à la suivante.
L'un de vous peut-il m'aider ?
d'avance Merci

yg_be · Answer

bonjour,
je pense que tu peux commencer par t'aider toi-même, en enregistrant une macro pendant que tu fais une partie des manipulations.
cela pourra peut-être servir de base.

simkmil · Answer

En effet, merci, je vais faire cela et je reviens après.

merci et bonne fin de journée

simkmil · Answer

voilà, j'ai fais un bout de code avec l'enregistreur de macro, mais ça ne fonctionne pas !
j'ai donc ouvert deux feuilles excel
sur la première j'ai écrit ma signature à partir du stylet sur le pen tablet
ensuite, je demande de transférer ma signature sur la feuille 2 et la rétrécir afin de la mettre dans une cellule précise.
le blocage se fait au niveau de la troisième ligne.

Sub pen_tablet()
'
' pen_tablet Macro
'

'
    Range("G5,J12").Select
    Range("J12").Activate
    ActiveSheet.Shapes.Range(Array("Ink 13")).Select
    Selection.ShapeRange.ScaleWidth 0.4509755047, msoFalse, msoScaleFromBottomRight
    Selection.ShapeRange.ScaleHeight 0.4509753408, msoFalse, _
        msoScaleFromBottomRight
    Selection.ShapeRange.IncrementLeft 3
    Selection.ShapeRange.IncrementTop -18
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Range("F13").Select
    ActiveSheet.Paste
End Sub

j'espère que vous pourrez m'aider.
D'avance merci

simkmil · Answer

Bonjour, à force de chercher et de faire des essais, je suis arrivé PRESQUE à ce que je voulais.
Voici donc le code que j'ai pu réaliser grâce à l'enregistreur de macro.
Mon problème maintenant est que je voudrais, à la place de rétrécir mon "image" en %, je voudrais lui donner une dimension fixe, la dimension s'adaptant dans la cellule qui lui est dédiée.

Merci

simkmil · Answer

Evidemment avec mon code, ce serait mieux !!

Sub pen_tablet()

Sheets("Feuil1").Select
Application.CutCopyMode = False
Sheets("feuil1").Range("D5:Q20").Copy
Sheets("Feuil2").Select
Range("J10").Select
ActiveSheet.Pictures.Paste.Select

Selection.Name = "Signature"
Application.CutCopyMode = False

    Selection.ShapeRange.ScaleWidth 0.8126672614, msoFalse, msoScaleFromBottomRight
    Selection.ShapeRange.ScaleHeight 0.8126671082, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.IncrementLeft -471
    Selection.ShapeRange.IncrementTop -21.75
    Selection.ShapeRange.ScaleWidth 0.2568605928, msoFalse, msoScaleFromBottomRight
    Selection.ShapeRange.ScaleHeight 0.2568604487, msoFalse, _
        msoScaleFromBottomRight
    Selection.ShapeRange.ScaleWidth 0.8418803419, msoFalse, msoScaleFromBottomRight
    Selection.ShapeRange.ScaleHeight 0.8418808775, msoFalse, _
        msoScaleFromBottomRight




End Sub

simkmil · Answer

Merci beaucoup, j'ai été très occupé la semaine dernière et n'ai pas su donner suite à mon projet.
Aujourd'hui, je vais m'y remettre !  J'ai noté l'ensemble de tes conseils et vais essayer de mettre cela en pratique.
Merci de ton aide et je reviens dire si tout fonctionne pour le mieux !

Bonne journée

simkmil · Answer

Bonjour, super !! tout fonctionne à merveille ! merci de ton aide. MAIS, j'ai maintenant un autre problème : auparavant, tout fonctionnait, et maintenant rien ne s'inscrit sur ma feuille "Historique_Commande" J'ai beau essayer de comprendre ce qu'il se passe, je ne vois rien d'incorrect. L'enregistrement dans le dossier "Archivage Factures" se fait correctement, ensuite l'effacement des différentes cases pour les vider se passe également bien. Mais après avoir fait cela, lorsque je vais voir dans la feuille Historique Commande, il n'y a rien d'inscrit. voici mon code :

Sub ArchiverBC() 'archiver les Bons de commande dans l'historique clients et incrémenter le numéro de Bon de commande ligne = Sheets("Historique_Commande").Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets("Historique_Commande").Range("A" & ligne).Value = Sheets("Bon de Commande").Range("E1").Value 'numero BC Sheets("Historique_Commande").Range("B" & ligne).Value = Sheets("Bon de Commande").Range("D3").Value 'Date Sheets("Historique_Commande").Range("C" & ligne).Value = Sheets("Bon de Commande").Range("C5").Value 'Nom Sheets("Historique_Commande").Range("D" & ligne).Value = Sheets("Bon de Commande").Range("E5").Value 'prénom Sheets("Historique_Commande").Range("E" & ligne).Value = Sheets("Bon de Commande").Range("C6").Value 'adresse Sheets("Historique_Commande").Range("F" & ligne).Value = Sheets("Bon de Commande").Range("C7").Value 'code postal Sheets("Historique_Commande").Range("G" & ligne).Value = Sheets("Bon de Commande").Range("C8").Value 'localité Sheets("Historique_Commande").Range("H" & ligne).Value = Sheets("Bon de Commande").Range("C9").Value 'téléphone Sheets("Historique_Commande").Range("I" & ligne).Value = Sheets("Bon de Commande").Range("E24").Value 'total TTC Sheets("Historique_Commande").Range("M" & ligne).Value = Sheets("Bon de Commande").Range("E32").Value 'Solde Sheets("Historique_Commande").Range("J" & ligne).Value = Sheets("Bon de Commande").Range("E26").Value 'Bancontact Sheets("Historique_Commande").Range("K" & ligne).Value = Sheets("Bon de Commande").Range("E27").Value 'Visa Sheets("Historique_Commande").Range("L" & ligne).Value = Sheets("Bon de Commande").Range("E28").Value 'Espèces Sheets("Historique_Commande").Range("N" & ligne).Value = Sheets("Bon de Commande").Range("H6").Value 'PRIX ACHAT Sheets("Historique_Commande").Range("S" & ligne).Value = Sheets("Bon de Commande").Range("J6").Value 'Fournisseur Sheets("Historique_Commande").Range("Q" & ligne).Value = Sheets("Bon de Commande").Range("E116").Value 'Coéfficient Sheets("Historique_Commande").Range("P" & ligne).Value = Sheets("Bon de Commande").Range("E115").Value 'Designation 1 Sheets("Historique_Commande").Range("R" & ligne).Value = Sheets("Bon de Commande").Range("B149").Value 'Montant reprise Sheets("Historique_Commande").Range("T" & ligne).Value = Sheets("Bon de Commande").Range("A14").Value 'Designation 2 Sheets("Historique_Commande").Range("U" & ligne).Value = Sheets("Bon de Commande").Range("A15").Value 'Désignation 3 Sheets("Historique_Commande").Range("V" & ligne).Value = Sheets("Bon de Commande").Range("A16").Value 'Désignation 4 Sheets("Historique_Commande").Range("W" & ligne).Value = Sheets("Bon de Commande").Range("A17").Value 'Désignation 5 Sheets("Historique_Commande").Range("X" & ligne).Value = Sheets("Bon de Commande").Range("A18").Value 'Désignation 6 Sheets("Historique_Commande").Range("Y" & ligne).Value = Sheets("Bon de Commande").Range("A19").Value 'Désignation 7 Sheets("Historique_Commande").Range("Z" & ligne).Value = Sheets("Bon de Commande").Range("A20").Value 'Désignation 8 Sheets("Historique_Commande").Range("AA" & ligne).Value = Sheets("Bon de Commande").Range("A21").Value 'Désignation 9 Sheets("Historique_Commande").Range("AB" & ligne).Value = Sheets("Bon de Commande").Range("A22").Value 'Désignation 1 Sheets("Historique_Commande").Range("AC" & ligne).Value = Sheets("Bon de Commande").Range("C11").Value 'reprise Sheets("Historique_Commande").Range("AD" & ligne).Value = Sheets("Bon de Commande").Range("C12").Value 'emporté Sheets("Historique_Commande").Range("AE" & ligne).Value = Sheets("Bon de Commande").Range("B24").Value & Sheets("Bon de Commande").Range("C24").Value 'date livraison 'fin de la partie BON de COMMANDE 'archivage du bon de commande 'Sub EnregistrementFacture() Dim NomDossier As String Dim Chemin As String NomDossier = Application.InputBox("ArchivageFactures:", "Année ?") Chemin = "C:\Users\bs382\OneDrive\Desktop\ArchivageFactures\" & NomDossier & "\" If NomDossier = "" Then Exit Sub ActiveSheet.ExportAsFixedFormat Type:=xlTypexlsm, Filename:= _ Chemin & "Bon de Commande N° _" & Range("E1").Value & " " & Range("C5").Value & ".xlsm", quality:= _ xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _ from:=1, to:=5, openafterpublish:=False '---------------------------------------------------------------------------------------------------------- 'Effacement pour passer au numéro suivant Sheets("Bon de Commande").Range("C5").ClearContents 'vider l'entete client-Nom Sheets("Bon de Commande").Range("E5").ClearContents 'vider l'entete client-Prénom Sheets("Bon de Commande").Range("C6:E10").ClearContents 'vider l'entete client-reste de l'entete Sheets("Bon de Commande").Range("A14:E22").ClearContents 'vider le corps de facture Sheets("Bon de Commande").Range("E29").ClearContents 'vider l'accompte Sheets("Bon de Commande").Range("E25:E27 ").ClearContents 'vider les accomptes Sheets("Bon de Commande").Range("C34:D34").ClearContents 'vider le montant mensuel Sheets("Bon de Commande").CheckBox1.Value = False ' vider les cases à cocher-Bancontact Sheets("Bon de Commande").CheckBox2.Value = False 'vider les cases à cocher-Visa Sheets("Bon de Commande").CheckBox3.Value = False 'vider les cases à cocher-Espèces Sheets("Bon de Commande").CheckBox4.Value = False 'vider les cases à cocher-Cofidis Sheets("Bon de Commande").CheckBox5.Value = False 'vider les cases à cocher-Cetelem Sheets("Bon de Commande").CheckBox6.Value = False 'vider les cases à cocher-Secci 'Sheets("Bon de Commande").Range("A32").ClearContents 'vider signature 'Sheets("Bon de Commande").Range("D107").ClearContents 'vider signature 'Sheets("Bon de Commande").Range("D161").ClearContents 'vider signature Sheets("Bon de Commande").Range("H6").ClearContents 'vider Prix d'achat Sheets("Bon de Commande").Range("J6").ClearContents 'vider nom du fournisseur Sheets("Bon de Commande").Range("J9").ClearContents 'vider nom du vendeur Sheets("Bon de Commande").Range("H11").ClearContents 'vider agios Sheets("Bon de Commande").Range("E112").ClearContents 'vider prix livraison Sheets("Bon de Commande").Range("B143").ClearContents 'vider Valeur reprise Sheets("Bon de Commande").Range("E1").Value = "FCB-" & Format(Right(Sheets("Bon de Commande").Range("E1").Value, 3) + 1, "000") End Sub merci de votre aide. et si nous ne nous correspondons pas d'ici là, je vous souhaite déjà une excellente année 2021