Utiliser une Pen Tablet sur Excel

Résolu/Fermé
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 - 12 déc. 2020 à 12:25
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 - 29 déc. 2020 à 17:13
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
A voir également:

7 réponses

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
12 déc. 2020 à 12:41
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.
0
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 34
12 déc. 2020 à 17:15
En effet, merci, je vais faire cela et je reviens après.

merci et bonne fin de journée
0
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 34
13 déc. 2020 à 10:35
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
0
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 34
13 déc. 2020 à 11:01
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 34
13 déc. 2020 à 11:02
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
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
13 déc. 2020 à 11:13
peut-être ainsi:
Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.RowHeight
0
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 34 > yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024
13 déc. 2020 à 11:48
merci, je vais essayer.
mais j'essaie de comprendre le code :
sélection de la hauteur de cellule égale le dessus gauche et idem pour la longueur.
Mais où se trouve le nom de ma cellule de destination ? dois je mettre Sheets("Feuil2").Range("J10") pour me trouver dans la cellule J10, là où je veux que ma signature apparaisse ?
Merci et bon dimanche
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024
Modifié le 13 déc. 2020 à 12:16
j'ai supposé que l'image était déjà au bon endroit, et qu'il suffisait d'adapter sa taille. tu as écrit que tout fonctionnait, à part la taille de l'image.
le code devrait adapter la taille de l'image en fonction de la taille de la cellule où elle se trouve (la cellule en haut à gauche de l'image).
je pense que l'image est
Selection.ShapeRange

et que la cellule est donc
Selection.ShapeRange.TopLeftCell


si tu veux positionner la cellule au bon endroit, il faut un autre code.
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024
13 déc. 2020 à 12:15
dim dessin as shape, cel as range
set dessin = Sheets("Feuil2").Pictures.Paste
set cel=Sheets("Feuil2").Range("J10")
dessin.left=cel.left
dessin.top=cel.top
dessin.Height=cel.RowHeight
dessin.Width=cel.ColumnWidth
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476 > yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024
13 déc. 2020 à 12:18
plutôt:
Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.ColumnWidth
0
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 34
21 déc. 2020 à 10:49
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
0
simkmil Messages postés 434 Date d'inscription mardi 19 février 2008 Statut Membre Dernière intervention 13 mars 2024 34
29 déc. 2020 à 16:53
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 :
<code basic>

</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
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
29 déc. 2020 à 17:13
je me demande si tu n'avais pas déjà eu un problème similaire, et que les données étaient, en fait, enregistrées beaucoup plus bas dans la feuille de destination.

je vois une erreur possible ici:
ligne = Sheets("Historique_Commande").Range("A" & Rows.Count).End(xlUp).Row + 1

ceci est préférable:
ligne = Sheets("Historique_Commande").Range("A" & Sheets("Historique_Commande").Rows.Count).End(xlUp).Row + 1

il faut se méfier de tous les range, rows, cells, ... sans précision de la feuille.
0