Utiliser une Pen Tablet sur Excel [Résolu]

Signaler
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
-
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021
-
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

7 réponses

Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021
782
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.
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
23
En effet, merci, je vais faire cela et je reviens après.

merci et bonne fin de journée
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
23
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
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
23
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
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
23
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
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021
782
peut-être ainsi:
Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.RowHeight
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
23 >
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021

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
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021
782 >
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021

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.
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021
782 >
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021

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
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021
782 >
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021

plutôt:
Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.ColumnWidth
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
23
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
Messages postés
267
Date d'inscription
mardi 19 février 2008
Statut
Membre
Dernière intervention
8 janvier 2021
23
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
Messages postés
13891
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 janvier 2021
782
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.