XL 2013 Caractères spéciaux

[coline741]

Bonjour Maîtresses, Maîtres et Autres bienveillants!

Grands connaisseurs des msgbox vba vous pourrez sans doute me dépanner.

Dans le fichier joint, en feuil1, nous avons une petite liste de caractères spéciaux, réalisée pour une partie avec la macro INSER en VBA et Ascii pour l'autre (macro XL4)

Serait-il possible de tout regrouper en VBA au moyen d'une msgbox qui reprendrait le visuel de la macro Ascii et où chaque caractère serait présenté comme suit

par exemple "Ø" suivi d'un bouton à cliquer, et hop!

J'ai joint la macro xl car depuis XL 1.5 je ne sais faire que ça (un gamin m'a dit que c'était obsolète...).

Je patine depuis quelques temps avec le VBA surtout les boîtes

Si vous pouvez,

D'avance merci.

 

[TooFatBoy]

Bonjour,

C'est marrant, mon antivirus me dit que ce fichier contient un cheval de Troie...

 

[Compte Supprimé 979]

ATTENTION !

Même chose pour moi

Je signal à l'administrateur

 

[coline741]

voici la macro Ascii que je viens de supprimer car en voulant l'ouvrir j'ai obtenu ce même message

C:\Users\xxxxx\AppData\Local\Microsoft\Windows\INetCache\Content.MSO\Copie de caractères spéciaux.xls a tenté de charger une ressource malveillante détectée comme XLM.Trojan.Abracadabra.40.Gen et a été bloqué. Votre appareil est en sécurité.

Le document datait de plusieurs jours, c'est marrant. Sans doute une burnerie de Bitdefender

Ascii

=ERREUR(FAUX)

=ENTRER("Choisissez"&CAR(13)&CAR(13)&"0126 = "&CAR(126)&CAR(13)&"0133 = "&CAR(133)&CAR(13)&"0149 = "&CAR(149)&CAR(13)&"0150 = "&CAR(150)&CAR(13)&"0216 = "&CAR(216);2;"ASCII";0

=FORMULE(CAR(B6))

=RETOUR()

Le nouveau fichier ne comporte plus de macro xl4. BD précise que le système est sûr

Merci à vous deux

TooFatBoy & BrunoM45​

 

[TooFatBoy]

Vous parlez de caractères spéciaux2 ?

Je vois mal comment #2 pourrait faire référence à un fichier de #4...

Pis... je me fais avoir une fois mais pas deux !


@+

 

[coline741]

L'avez-vous téléchargé au moins ?

 

[Dranreb]

Bonsoir.
Et en cliquant sur un bouton du UserForm représentant ce caractère, ça devrait faire quoi ?
Une possibilité par exemple serait de l'envoyer dans le presse-papier !
Remarquez: ça ferait peut être un peu double emploi avec la commande Symbole du groupe Symboles du menu insérer.

Un essai :

 

[job75]

Bonjour coline741, le forum,

Voyez le fichier joint et ces 2 macros :

Sub Creer_Images()
Dim r As Range, s
Set r = [A3:A18] 'à adapter
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, r) Is Nothing Then s.Delete 'RAZ
Next
For Each r In r
    r.CopyPicture
    ActiveSheet.Paste
    Selection.Left = r.Left
    Selection.Top = r.Top
    Selection.OnAction = "Copier"
Next
ActiveCell.Activate
End Sub

Sub Copier()
On Error Resume Next
ActiveCell = ActiveSheet.Shapes(Application.Caller).TopLeftCell
End Sub

La macro Copier est affectée aux images créées en colonne A.

A+

 

[coline741]

Bonjour Danreb,

Merci pour ta participation et le résultat adressé mais je ne capte pas grand chose, de plus je ne peux l'utiliser

Si je comprends bien :

L'objet UFmCarSpc doit contenir l'image du caractère à choisir et UFmMsg le bouton d'appel de la macro

Module 1 devrait permettre de lancer la macro via F8

Pour MPressePapier, là je reste baba en raison d'une compréhension limitée

En fait dans la macro Inser

Sub INSER()
Dim Cellule As Range
Set Cellule = ActiveCell
With Cellule
.Value = ici le caractère choisi (sans action manuelle bien sûr)
End With
End Sub

Cette macro sera inserée dans un démarrage excel afin de pouvoir l'utiliser partout

Merci en attendant

 

[coline741]

Bonjour coline741, le forum,

Voyez le fichier joint et ces 2 macros :

Sub Creer_Images()
Dim r As Range, s
Set r = [A3:A18] 'à adapter
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, r) Is Nothing Then s.Delete 'RAZ
Next
For Each r In r
    r.CopyPicture
    ActiveSheet.Paste
    Selection.Left = r.Left
    Selection.Top = r.Top
    Selection.OnAction = "Copier"
Next
ActiveCell.Activate
End Sub

Sub Copier()
On Error Resume Next
ActiveCell = ActiveSheet.Shapes(Application.Caller).TopLeftCell
End Sub

La macro Copier est affectée aux images créées en colonne A.

A+

Merci à toi Job75 mais ce n'est pas le but recherché. Vois ma réponse à Danreb ci-dessus

En fait : Action

Je suis sur une cellule sur une feuille quelconque, F8, je lance la macro, apparait un tableau de 16 cases, je clique sur l'une d'elle, le caractère choisi apparait dans la cellule

A plus je reste là! .....

 

[job75]

apparait un tableau de 16 cases

Avec mes macros un UserForm est tout à fait inutile.

Quand un UserForm peut être évité il faut l'éviter.

 

[Lone-wolf]

Bonjour coline741, le forum,

Voyez le fichier joint et ces 2 macros :

Sub Creer_Images()
Dim r As Range, s
Set r = [A3:A18] 'à adapter
For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, r) Is Nothing Then s.Delete 'RAZ
Next
For Each r In r
    r.CopyPicture
    ActiveSheet.Paste
    Selection.Left = r.Left
    Selection.Top = r.Top
    Selection.OnAction = "Copier"
Next
ActiveCell.Activate
End Sub

Sub Copier()
On Error Resume Next
ActiveCell = ActiveSheet.Shapes(Application.Caller).TopLeftCell
End Sub

La macro Copier est affectée aux images créées en colonne A.

A+

Bonjour Job75

Le Fil, le Forum.

 

[coline741]

Bonjour Job75

Le Fil, le Forum.

Bonjour Lone-Wolf

Merci pour ta réponse, mais je ne recherche pas le copier-coller.

Je ne peux pas utiliser et ne sait transformer la réponse de Danreb ci-avant. Cependant il me semble que l'objet UFmCarSpc doit contenir l'image du caractère à choisir.

Je reprends mes précisions dans le fil de la discussion:

Cette macro sera inserée dans un fichier de démarrage excel afin de pouvoir l'utiliser partout. Le fichier se charge au démarrage et est masqué.

En fait : Action sur un nouveau fichier que je crée

Je me mets sur une cellule quelconque (ex. B3) sur la feuil1, ALT+F8, je lance le nom de la macro, apparait un tableau de 16 cases, je clique sur l'une d'elle, le caractère choisi apparait dans la cellule B3

Voilà, pas de copier-coller à partir d'un document tiers.

C'est ce que je fais actuellement car avec windows 11 sur un portable sans clavier numérique....

Désolé pour la migraine!

 

[Dranreb]

Bonjour.
J'ai tenté d'adapter pour 64 bits.
À tester (je n'ai pas la version d'office pour ça) …
Remarque: La programmation avec un MSForms.DataObject est considérablement plus simple :

Property Get PressePapier() As String
   On Error Resume Next
   With New MSForms.DataObject: .GetFromClipboard: PressePapier = .GetText: End With
   If Err Then MsgBox "Pas de données récupérées", vbCritical, "PressePapier"
   End Property
Property Let PressePapier(ByVal Z As String)
   With New MSForms.DataObject: .SetText Z: .PutInClipboard: End With
   UFmMsg.Dit Z, "Copié :"
   End Property

Dommage qu'elle soit si peu fiable. En effet, souvent, au lieu de récupérer le texte copié, il récupère deux codes ascii élevés ne correspondant à aucun caractère.

 

[job75]

Puisque vous insistez coline741 voyez ce fichier (2) et le code de l'UserForm :

Private Sub Label1_Click(): ActiveCell = Label1: End Sub

Private Sub Label2_Click(): ActiveCell = Label2: End Sub

Private Sub Label3_Click(): ActiveCell = Label3: End Sub

Private Sub Label4_Click(): ActiveCell = Label4: End Sub

Private Sub Label5_Click(): ActiveCell = Label5: End Sub

Private Sub Label6_Click(): ActiveCell = Label6: End Sub

Private Sub Label7_Click(): ActiveCell = Label7: End Sub

Private Sub Label8_Click(): ActiveCell = Label8: End Sub

Private Sub Label9_Click(): ActiveCell = Label9: End Sub

Private Sub Label10_Click(): ActiveCell = Label10: End Sub

Private Sub Label11_Click(): ActiveCell = Label11: End Sub

Private Sub Label12_Click(): ActiveCell = Label12: End Sub

Private Sub Label13_Click(): ActiveCell = Label13: End Sub

Private Sub Label14_Click(): ActiveCell = Label14: End Sub

Private Sub Label15_Click(): ActiveCell = Label15: End Sub

Private Sub Label16_Click(): ActiveCell = Label16: End Sub

Private Sub UserForm_Initialize()
Dim a, i%
a = Array(ChrW(&H2642), ChrW(&H2640), ChrW(&H266A), ChrW(&H266B), ChrW(&H263C), ChrW(&H25BA), ChrW(&H25C4), ChrW(&H25BC), _
    ChrW(&H2660), ChrW(&H2663), ChrW(&H2665), ChrW(&H2666), ChrW(&H7E), ChrW(&HD8), ChrW(&H2013), ChrW(&H2026))
For i = 0 To UBound(a)
    Me("Label" & i + 1) = a(i)
Next
End Sub

On pourrait éviter la répétition des 16 macros des Labels avec un module de classe mais bof...