XL 2019 Copier le contenu d'un MsgBox ou d'une variable

[Attila451]

Bonjour,
J'ai une routine qui cumule les valeurs contenues dans une colonne.
Le total est envoyé dans la variable "cumul" et un MsgBox indique : "Le total est de .. "

Sans aller copier le résultat vers une cellule, je voudrais savoir comment faire pour copier le résultat du MsgBox, et donner à l'utilisateur le choix d'aller copier où il veut (soit sur un endroit qu'il choisit dans excel ou sur outlook.

A défaut, je cherche à savoir comment copier la valeur de ma variable "cumul" pour de la même manière, laisser le choix à l'utilisateur d'aller coller où bon lui semble.
Merci d'avance pour votre aide !

 

[vgendron]

Bonjour

Pour demander à l'utilisateur de selectionner une cellule
Ici=application.inputbox ("Cliquez sur la cellule destination",type:=8)

ici=cumul

 

[wDog66]

Bonjour Attila451

On peut faire un truc du style

Sub calcul()
  Dim ligori As Long
  Dim cumul As Long
  ligori = 1
  While Cells(ligori, 1) <> ""
    cumul = Cells(ligori, 1) + cumul
    ligori = ligori + 1
  Wend
  MsgBox "Le total est de " & cumul
  On Error Resume Next
  Dim Rng As Range
OnRecommence:
  Set Rng = Application.InputBox("Sélectionnez la cellule dans laquelle coller le résulat", "CHOIX CELLULE", Type:=8)
  If Err <> 0 Then
    Err.Clear
    MsgBox "Vous devez sélectionner une cellule !"
    GoTo OnRecommence
  End If
  Rng.Value = cumul
End Sub

A+

 

[Attila451]

Bonjour,
Merci pour vos réponses, par contre existe il un moyen de coller directement sur un mail ?
Habituellement, je génère un resultat sur un fichier excel, je copie le résultat depuis la feuille excel et je colle sur un mail.
Dans mon cas, j'arrive à générer le résultat sur le MsgBox mais par contre, je n'arrive pas à copier le MsgBox.
Le MsgBox se génére avec la variable "cumul" mais je n'arrive pas non plus à la copier.

Je cherche en fait à trouver comment donner l'instruction MsgBox.copy, pour copie le contenu de MsgBox.

Désolé si je ne suis pas assez clair, en tout cas merci d'avance !

 

[Dranreb]

Bonjour.
En principe on pourrait utiliser un objet MSForms.DataObject pour envoyer ou récupérer du texte dans le presse-papier. Malheureusement il n'est pas fiable du tout. Alors j'utilise ça :

Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Property Let PressePapier(ByVal sUniText As String)
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Const GMEM_MOVEABLE As Long = &H2
   Const GMEM_ZEROINIT As Long = &H40
   Const CF_UNICODETEXT As Long = &HD
   OpenClipboard 0&
   EmptyClipboard
   iLen = LenB(sUniText) + 2&
   iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
   iLock = GlobalLock(iStrPtr)
   lstrcpy iLock, StrPtr(sUniText)
   GlobalUnlock iStrPtr
   SetClipboardData CF_UNICODETEXT, iStrPtr
   CloseClipboard
   End Property
Public Property Get PressePapier() As String
   Dim iStrPtr As Long
   Dim iLen As Long
   Dim iLock As Long
   Dim sUniText As String
   Const CF_UNICODETEXT As Long = 13&
   OpenClipboard 0&
   If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
      iStrPtr = GetClipboardData(CF_UNICODETEXT)
      If iStrPtr Then
         iLock = GlobalLock(iStrPtr)
         iLen = GlobalSize(iStrPtr)
         sUniText = String$(iLen \ 2& - 1&, vbNullChar)
         lstrcpy StrPtr(sUniText), iLock
         GlobalUnlock iStrPtr
         End If
      PressePapier = sUniText
      End If
   CloseClipboard
   End Property

 

[Attila451]

Bonjour Dranreb,
Merci pour le retour, je pensais qu'il y a avait une option plus simple pour mon modeste niveau.
En tout cas merci pour la recherche !

 

[jurassic pork]

Hello,
avec le code de Dysorthographie c'est plus simple :

Public Function ClearPressePapier()
With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
End Function
Public Property Let PressePapier(valeur)
With CreateObject("htmlfile").parentwindow.clipboardData.setData("Text", valeur): End With
End Property
Public Property Get PressePapier()
PressePapier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
End Property

Sub calcul()
Dim ligori As Long
Dim cumul As Long
ligori = 1
While Cells(ligori, 1) <> ""
cumul = Cells(ligori, 1) + cumul
ligori = ligori + 1
Wend
'MsgBox "Le total est de " & cumul
ClearPressePapier
PressePapier = CStr(cumul)  'cumul se retrouve dans le pressePapier
End Sub

La valeur de la variable cumul se retrouve dans le presse-papier, il n' y a plus qu'à la coller.

Ami calmant, J.P

 

[Attila451]

Bonsoir,
Merci pour cette simplification !

 

[Staple1600]

Bonsoir le fil

[Une question en passant]
Pourquoi VBA est dans la place ?
1) Tableau structuré
2) Une formule somme

3) CTRL+C puis CTRL+V

 

[mapomme]

Bonsoir à tous,

Pour le fun... On peut aussi prendre le problème à l'envers (uniquement pour collage au sein du classeur)

• on sélectionne la cellule de destination (sur n'importe quelle feuille du classeur)
• on tape la combinaison des deux touches Ctrl + i

La macro Calcul a été associée à la combinaison der touches Ctrl + i .

code de la macro Calcul :

Sub Calcul()
Dim ligori As Long, cumul As Long
   With Sheets("Feuil1")
      ligori = 1: Do Until .Cells(ligori, "a") = "": cumul = cumul + .Cells(ligori, "a"): ligori = ligori + 1: Loop
   End With
   ActiveCell = cumul
End Sub

Pour associer la macro "Calcul"à une combinaison de touches (voit fichier gif joint) :

• Dans le menu "Développeur", cliquer sur "Macros" (ou Alt+F8)
• Dans la fenêtre qui s'ouvre, sélectionner la macro Calcul puis cliquer sur le bouton "Options..."
• Dans la fenêtre qui s'ouvre, tapez la lettre raccourci (attention - on distingue les majuscules des minuscules)
• Tapez un commentaire (facultatif)
• cliquer sur le bouton "OK" pour refermer la fenêtre
• Refermer la fenêtre "Macro"

 

[mapomme]

Re,

Une version qui copie simplement le cumul dans le presse-papier.
Pour copier le cumul dans le presse-papier, tapez la combinaison des deux touches Ctrl+i.
On peut donc coller n'importe où après.

On utilise un DataObject (avec quelquefois ses comportements erratiques).

Le code de la macro Calcul associée à Ctrl+i :

Sub Calcul()
Dim ligori&, cumul&, i&, j&, DataObj As New DataObject
   With Sheets("Feuil1")
      ligori = 1: Do Until .Cells(ligori, "a") = "": cumul = cumul + .Cells(ligori, "a"): ligori = ligori + 1: Loop
      DataObj.SetText cumul: DataObj.PutInClipboard
      MsgBox "Le cumul : " & Format(cumul, "#,##0") & " a été copié dans le presse-papier."
   End With
End Sub

 

[Attila451]

Re,

Une version qui copie simplement le cumul dans le presse-papier.
Pour copier le cumul dans le presse-papier, tapez la combinaison des deux touches Ctrl+i.
On peut donc coller n'importe où après.

On utilise un DataObject (avec quelquefois ses comportements erratiques).

Le code de la macro Calcul associée à Ctrl+i :

Sub Calcul()
Dim ligori&, cumul&, i&, j&, DataObj As New DataObject
   With Sheets("Feuil1")
      ligori = 1: Do Until .Cells(ligori, "a") = "": cumul = cumul + .Cells(ligori, "a"): ligori = ligori + 1: Loop
      DataObj.SetText cumul: DataObj.PutInClipboard
      MsgBox "Le cumul : " & Format(cumul, "#,##0") & " a été copié dans le presse-papier."
   End With
End Sub

 

[Attila451]

Bonjour,
Merci pour l'aide !