Utiliser une Pen Tablet sur Excel

Résolu
simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
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.
    yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
  2. simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   35
     
    En effet, merci, je vais faire cela et je reviens après.

    merci et bonne fin de journée
    0
  3. simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   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
  4. simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   35
     
    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

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

    Posez votre question
  6. simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   35
     
    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
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      peut-être ainsi: 
      Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.RowHeight
      0
      1. simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   35 > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
         
        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
      2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention  
         
        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
      3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
          
        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
      4. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
         
        plutôt: 
        Selection.ShapeRange.Height = Selection.ShapeRange.TopLeftCell.RowHeight
Selection.ShapeRange.Width= Selection.ShapeRange.TopLeftCell.ColumnWidth
        0
  7. simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   35
     
    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
  8. simkmil Messages postés 505 Date d'inscription   Statut Membre Dernière intervention   35
     
    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
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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

Discussions similaires

Peut-on utiliser des ticket kadéos infini sur internet ?
Mnoir et blanc -
Pascal -

46 réponses