VBA - PutInClipboard - Copiare testo formattato negli appunti

di il
0 risposte

VBA - PutInClipboard - Copiare testo formattato negli appunti

Buongiorno a tutti.

Ho creato una procedura che mi permette, richiamandola, di copiare negli appunti un certo testo.

Il testo differisce in funzione del tipo (richiesto da una InputBox al lancio della  sub).

Questo mi permette, avendo lunghi testi sempre uguali che, a seconda del caso, inserisco in alcune parti di e-mail al bisogno, di chiamare la funzione da Outlook, digitare solo il numero della scelta nella InputBox , ed avere automaticamente copiato negli appunti un lungo testo che poi posiziono dove occorre nella mail semplicemente incollando gli appunti.

Tutto funziona, ma non riesco ad copiare/incollare testo formattato, diversamente da quando esegui l'operazione manualmente selezionando copiando ed incollando un testo in qualunque modo formattato. 

Es. non riesco a salvare una parte di testo in neretto, oppure sottolineata, oppure con caratteri di colore diverso. Riesco solo a salvare un testo senza alcuna formattazione.

Ho provato a salvare una stringa di testo che contiene i parametri Html di formattazione (es. <b> oppure <u> oppure <BODY style=font-size:11pt;font-family:Calibri> etc etc, ma, quando lancio la sub, da “errore di run-time 91, variabile oggetto o variabile del blocco With non impostata” ed in effetti nel debug posizionandosi col cursore su RispStandard  appare RispStandard =Nothing

Se invece sostituisco tutti i dimensionamenti variabili  con String invece che HTMLText , tutto funziona ed incolla ma senza formattazione, tratta chiaramente i parametri come testo normale non come istruzioni per la formattazione (dovrei quindi salvare un testo senza i riferimenti HTML e procedere alla formattazione dopo averlo incollato, perdendo però parte del tempo risparmiato)

Posto il codice che va in errore

Sub MettiInAppunti(Valore As HTMLText)
   Dim oDO As New DataObject
   oDO.SetText Valore, CF_HTML
   oDO.PutInClipboard
   Set oDO = Nothing
End Sub

 Sub MettiInAppuntiScelta()
   Dim RispStandard As HTMLText, xTesto As Integer
   xTesto = InputBox("digita la Scelta" & vbCrLf & "1 - xxxxxxxx" & vbCrLf & "2 - yyyyyyyyy", "Scegli")
If xTesto = 1 Then
   RispStandard = "<p>testo lungo 1.</p>"
ElseIf xTesto = 2 Then
   RispStandard = ("<p><BODY style=font-size:11pt;font-family:Calibri>testo lungo 2.... .</p>" _
       & "<p></p>" _
       & "<p>inoltre.....</p>" _
       & "<p></p>" _
       & "<p><b>testo lungo 2 segue.....</b></p>" _
       & "<p></p>" _
       & "</BODY>")
End If
   Call MettiInAppunti(RispStandard)
End Sub

Questo invece senza formattazione svolge la funzione desiderata

Sub MettiInAppunti(Valore As String)
   Dim oDO As New DataObject
   oDO.SetText Valore                 ', CF_HTML
   oDO.PutInClipboard
   Set oDO = Nothing
End Sub

Sub MettiInAppuntiScelta()
   Dim RispStandard As String, xTesto As Integer
   xTesto = InputBox("digita la Scelta" & vbCrLf & "1 - xxxxxxxx" & vbCrLf & "2 - yyyyyyyyy", "Scegli")
If xTesto = 1 Then
   RispStandard = "testo lungo 1."
ElseIf xTesto = 2 Then
   RispStandard = "testo lungo 2.... ."
End If
   Call MettiInAppunti(RispStandard)
End Sub

Qualcuno sa aiutarmi ed indicarmi dove commetto errori ?

Anticipatamente grazie.

Devi accedere o registrarti per scrivere nel forum
0 risposte