Microsoft 365 couper/copier/coller le texte en tout ou partie dans le TextBox1 (casse méninges 1 du WE)

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous,
Je vous souhaite un bon WE :)

PS pour notre @patricktoulon qui m'a mis au défit de trouver des trucs bien loufoques pour ce WE ... hé bien, j'en ai 2 qui seront, je pense, pas mal, pour toi et pour notre @mapomme lol :p

Ce fil a été résolu grâce à tous les participants que je remercie encore une fois :)
Plusieurs solutions fonctionnelles ont été proposées.

J'en ai retenu une qui me convient parfaitement et j'ai 2 questions (casse méninges du WE) et voici la première :
Est-il possible de couper/copier/coller le texte en tout ou partie "directement" dans le TextBox1
1648281398989.png

J'ai tenté et fait des recherches et jusqu'à maintenant, je n'ai pas trouvé ...
Auriez-vous la solution ?
Un grand merci à toutes et à tous,
Je joins un p'tit fichier test et je continue mes recherches ...
lionel :)
 

Pièces jointes

  • inputBox_ModifCelluleP_OK2.xlsm
    46.6 KB · Affichages: 7
Dernière édition:
Solution
Vide le Clipboard avec le code :
VB:
Sub Vide()
[A1].Copy [A1]
End Sub
et exécute la macro ComboBox1_Change après avoir retiré On Error Resume Next...
re
Bonjour @job75
Ok vu
ci dessous exactement le même mais avec un vrai menu contextuel dans un module
dans un module standard
VB:
'***********************************************
'Menu contextuel "couper/copier/coller" sur textbox dans userform
'patricktoulon
'menu change sur la base de la version combobox de @job75
'*************************************************************
Option Explicit
Dim ctrl As Object
Sub createmenu(ctl As Object)
    Dim barre, arrbutton, I%: delebar: Set ctrl = ctl
    arrbutton = Array("Couper", "Copier", "Coller")
    Set barre =...

job75

XLDnaute Barbatruc
Bon j'y vais de ma solution.

Voyez ce (2), j'ai créé un menu contextuel avec une ComboBox :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ComboBox1
    If .Visible Then .Activate: .Value = "": .Visible = False
End With
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then [E3].Activate: TextBox1.Activate: ComboBox1.Visible = True: ComboBox1.DropDown
End Sub

Private Sub ComboBox1_Change()
Dim n%
With ComboBox1
    n = .ListIndex
    If n = -1 Then Exit Sub
    .Value = "": .Visible = False
End With
TextBox1.Activate
CreateObject("WScript.Shell").SendKeys IIf(n = 0, "^x", IIf(n = 1, "^c", "^v")) 'envoi les touches
End Sub
La hauteur de la ComboBox est 2,25 pour masquer la zone de restitution et la flèche.

Tout est sur une feuille de calcul mais on peut adapter à un UserForm.
 

Pièces jointes

  • Classeur(2).xlsm
    25.5 KB · Affichages: 2

Staple1600

XLDnaute Barbatruc
Re, Bonjour job75

=>Lionel
Evidemment puisque le code concerne l'userform
Donc le collage des couleurs ne concernent pas les cellules.
Enrichi (BBcode):
Sub fontcolor()
 If Application.Dialogs(xlDialogEditColor).Show(2, 255, 0, 0) = True Then
 usf.Controls(Application.CommandBars.ActionControl.Tag).ForeColor = ActiveWorkbook.Colors(2)
End If
End Sub
 

job75

XLDnaute Barbatruc
Avec un UserForm c'est presque la même chose, fichier (3) :
VB:
Private Sub Combobox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With ComboBox1
    If .Visible Then .SetFocus: .Value = "": .Visible = False
End With
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then TextBox1.SetFocus: ComboBox1.Visible = True: ComboBox1.DropDown
End Sub

Private Sub ComboBox1_Change()
Dim n%
With ComboBox1
    n = .ListIndex
    If n = -1 Then Exit Sub
    .Value = "": .Visible = False
End With
TextBox1.SetFocus
CreateObject("WScript.Shell").SendKeys IIf(n = 0, "^x", IIf(n = 1, "^c", "^v")) 'envoi les touches
End Sub
 

Pièces jointes

  • Classeur(3).xlsm
    33.2 KB · Affichages: 3

Usine à gaz

XLDnaute Barbatruc
Re-Gérard,

lol, j'ai enfin compris et ça fonctionne, merci :)

Mais faudrait que ce soit dans le contexte de mon fichier.
Patrick a approché la solution au #post 38 mais pas complètement voire #post 45.

Mais je garde ton fichier dans mes tablettes dans mon "gros" dossier "Gérard" :)
 

patricktoulon

XLDnaute Barbatruc
Re-Patrick :)
Retour de tests :
1° le couper
prend bien en compte le bout de texte sélectionné : pas exemple "Forum"
Mais si je veux coller avant "bonjour", il colle bien "Forum" mais efface tout le reste
2° le copier
Ne prend pas en compte la partie sélectionnée et don : ne colle rien
3° Font color
Mets bien en couleur le texte dans le TextBox1 mais ne colore pas le texte de la cellule cliquée
4° Back color
pareil

Mais c'est génial ton code et ce serait super de chez super si ....
Et si ça pouvait aussi décapsuler ma bouteille de bière alors là ..... 😂🤣
Merci Patrick :)
pour 3 et 4 ben ce menu n'est que pour le userform pas les cellules( les cellules elle l'ont dans leur menu

je vais regarder pour le reste
 

patricktoulon

XLDnaute Barbatruc
re
maintenant tu a la copie partielle et le coller (de type insertion)
VB:
Sub ncopier()
    Dim valeur$
    valeur = usf.Controls(Application.CommandBars.ActionControl.Tag).Value
    If TypeName(CtrL) = "TextBox" Then
        If CtrL.SelLength > 0 Then If CtrL.SelLength < Len(CtrL.Value) Then valeur = Mid(CtrL.Value, CtrL.SelStart + 1, CtrL.SelLength)
    End If
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText valeur: .PutInClipboard: End With
End Sub

Sub ncoller()
    Dim valeur$, oldvaleur$
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .GetFromClipboard: valeur = .GetText: End With
    If UBound(Split(valeur, vbCrLf)) = 1 Then valeur = Replace(valeur, vbCrLf, "")
    Select Case TypeName(CtrL)
    Case "ComboBox"
        'Control.Value = valeur'selectionne l'item
        Control.AddItem valeur    'j'ajoute un item a la combo (il faut quelle soit développée)
        Control.DropDown
    Case "TextBox"
        With CtrL
            oldvaleur = .Value
            If .SelStart > 0 And Len(.Value) > 0 Then
                .Value = Mid(oldvaleur, 1, .SelStart) & valeur & Mid(oldvaleur, .SelStart + 1, Len(.Value))
            Else
                .Value = valeur
            End If
        End With
    End Select
    'With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText "": .PutInClipboard: End With
End Sub
 

patricktoulon

XLDnaute Barbatruc
correction pour le coller ayant le textbox selectionner partiellement
là on a un effet de replace
VB:
Sub ncoller()
    Dim valeur$, oldvaleur$
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .GetFromClipboard: valeur = .GetText: End With
    If UBound(Split(valeur, vbCrLf)) = 1 Then valeur = Replace(valeur, vbCrLf, "")
    Select Case TypeName(CtrL)
    Case "ComboBox"
        'Control.Value = valeur'selectionne l'item
        Control.AddItem valeur    'j'ajoute un item a la combo (il faut quelle soit développée)
        Control.DropDown
    Case "TextBox"
        With CtrL
            oldvaleur = .Value
            If .SelStart > 0 And Len(.Value) > 0 Or .SelLength > 0 Then
                .Value = Mid(oldvaleur, 1, .SelStart) & valeur & Mid(oldvaleur, .SelStart + .SelLength + 1, Len(.Value))
            Else
                .Value = valeur
            End If
        End With
    End Select
    'With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText "": .PutInClipboard: End With
End Sub

resultat tu as
1° copier partiel ou entier
2° coller entier insertif ou replace partiel

avec ça Mr je vous fait le niveaux et le pare brise
diabolo.gif
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Re-Patrick :)

Encore une belle avancée ... tu es tout près du bonheur :)

le couper
Prend bien en compte le bout de texte sélectionné : par exemple "Forum"
Mais si je veux coller avant la 1ère lettre du texte "bonjour", il colle bien "Forum" mais remplace tout le reste
le copier

pareil

En revanche, si je colle à partir de la 2eme lettre du texte, ça fonctionne nickel :)
1648321501025.png

Formidable travail.
C'est déjà presque tout bien :)
 
Dernière édition:

Statistiques des forums

Discussions
314 667
Messages
2 111 700
Membres
111 264
dernier inscrit
Monnoye