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

Usine à gaz · 26 Mars 2022

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

Ce fil a été résolu grâce à tous les participants que je remercie encore une fois

Microsoft 365 - InputBox : saisir ou modifier le contenu de la cellule cliquée à l'aide de l'InputBox

Bonjour à toutes et à tous, Je vous souhaite un beau dimanche :) Pour des besoins dans l'un de mes fichiers de travail, je voudrais saisir ou modifier le contenu de la cellule cliqué à l'aide de l'InputBox : l'InputBox prenant le contenu de la cellule (vide ou non), je saisi dans l'InputBox, 1...

www.excel-downloads.com

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

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

patricktoulon · 28 Mars 2022

job75 à dit:
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 · 26 Mars 2022

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.

Staple1600 · 26 Mars 2022

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

Usine à gaz · 26 Mars 2022

Re-Gérard,

Merci pour cette solution mais je n'arrive pas à la faire fonctionner lol

job75 · 26 Mars 2022

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

Usine à gaz · 26 Mars 2022

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 · 26 Mars 2022

Re-Patrick

Usine à gaz à dit:
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

Staple1600 · 26 Mars 2022

patricktoulon à dit:
Re-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

Oui, c'est ce que j'ai dit au monsieur dans le message#47

patricktoulon · 26 Mars 2022

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 · 26 Mars 2022

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

Staple1600 · 26 Mars 2022

Re

Juste pour prévenir les Macistes qui passeront dans ce fil
Le code VBA de patrick ne fonctionne que sur Windows

NB: Les vrais amateurs d'Excel utilisent des PC sous Windows

patricktoulon · 26 Mars 2022

@Staple1600
pour les matchiste si je ne me trompe pas jusqu’à la version 11 d'excel
remplacer le create avec le guid(Clisd) pas le même en early binding
dim clip as new dataobject
with clip
'........

Staple1600 · 26 Mars 2022

Re

Je ne connais que les PCistes et les MACistes
Et dans les Matchistes, je mettrai Djoko, mais lui il gaze avec une raquette, pas avec un tableur.

Usine à gaz · 26 Mars 2022

patricktoulon à dit:
Re-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

Re-Patrick, le 3 et le 4 pas importants pour moi, c'est surtout les 1 et 2

Usine à gaz · 26 Mars 2022

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

Formidable travail.
C'est déjà presque tout bien

Usine à gaz · 26 Mars 2022

fichier qui fonctionne ..... presque

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

Usine à gaz

XLDnaute Barbatruc

Microsoft 365 - InputBox : saisir ou modifier le contenu de la cellule cliquée à l'aide de l'InputBox

Pièces jointes

patricktoulon

job75

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Discussions similaires