Utiliser une Pen Tablet sur Excel

Résolu
simkmil -  
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

  1.  simkmil Auteur
    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
    1. yg_be Contributeur
      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.
  2. simkmil Auteur
    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
    1. simkmil Auteur
      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
      1. yg_be Contributeur
        peut-être ainsi: 
        Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.RowHeight
      2.  simkmil Auteur
        @yg_bemerci, 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
      3. yg_be Contributeur
        @simkmilj'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.
      4. yg_be Contributeur
        @yg_be
        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
      5.  yg_be Contributeur
        @yg_beplutôt: 
        Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.ColumnWidth
    2.  simkmil Auteur
      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
      2. simkmil Auteur
        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
        1. simkmil Auteur
          En effet, merci, je vais faire cela et je reviens après.

          merci et bonne fin de journée
          1. yg_be Contributeur
            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.