Autres Collage spécial en vba

[botanicus]

Bonjour,

(Je suis sous Excel 2003 ; je sais ce n'est pas le dernier cri mais je ne pense pas que cela diffère....)

Voici mon problème :

J'ai des colonnes formatées en "Monétaire, 2 décimales, symbole €"

Lorsque je copie un nombre décimal quelconque hors Excel (par exemple sur un site Internet), et que je le colle dans mon tableau avec Edition/Collage spécial/Texte afin de ne pas copier le format d'origine, ma cellule conserve bien mon format personnalisé. OK, c'est ce que je veux.

Maintenant, pour éviter cette manip à chaque fois, j'ai enregistré une macro en faisant exactement la même chose. Mais, quand je lance la macro, le nombre collé se retrouve en format texte, sans tenir compte du format de la cellule.
Et, pire encore, je ne peux même plus reformater la cellule manuellement comme je veux, elle reste toujours en mode Texte !

Pour info, la macro enregistrée automatiquement donne simplement :

Sub Macro1()
    ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
End Sub

Que faut-il mettre dans le paramètre Format pour conserver mon formatage personnalisé, ou faut-il ajouter d'autres paramètres ?
Merci d'avance pour votre aide.

 

[TooFatBoy]

Bonjour,

As-tu essayé un truc du genre :

ActiveSheet.PasteSpecial Paste:=xlPasteValues

 

[botanicus]

Bonjour,
Merci pour la réponse rapide !
Malheureusement cela ne fonctionne pas, l'exécution de la macro telle quelle renvoie une erreur "La méthode PasteSpecial de la classe Worksheet a échoué."
@+

 

[TooFatBoy]

Ah oui, c'est dommage.

 

[Phil69970]

Bonjour @botanicus , TFB

@botanicus :
J'ai pas trouvé ton fichier.

@Phil69970

 

[sylvanu]

Bonjour tout le monde,
Et avec :

ActiveSheet.PasteSpecial Format:="Standard", Link:=False, DisplayAsIcon:=False

?

 

[TooFatBoy]

 

[sylvanu]

Plus ça rate et plus on a de chances que ça marche...

 

[TooFatBoy]

Plus ça rate et plus on a de chances que ça marche...

C'est un proverbe Shadok, non ?

 

[sylvanu]

 

[Dranreb]

Bonjour.
Vous pourriez essayer mon module MPressePapier :

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

Ça remplace un code beaucoup plus simple à base de MSForms.DataObject mais qui hélas n'est pas très fiable car il se met top souvent à envoyer dans le presse papier deux codes ascii de valeurs haute au lieu du texte voulu.
Essayez ensuite :

ActiveCell.Value = CCur(PressePapier)

En cas d'erreur étudiez le contenu de PressPapier et supprimez en les caractères qui empêcheraient cette conversion en Currency.

 

[botanicus]

Merci pour vos réponses, mais rien ne marche....
@ Dranreb : rien compris !
@ sylvanu : avec "Standard", même message d'erreur
@ Phil69970 : peu importe le fichier, c'est un cas général, même sur une feuille vierge et une seule cellule formatée.
Tant pis, laissez tomber, merci d'avoir pris le temps d'essayer de m'aider !
Je vais continuer comme avant, manuellement....
@+

 

[Phil69970]

@botanicus

@ Phil69970 : peu importe le fichier, c'est un cas général, même sur une feuille vierge et une seule cellule formatée.

Et non la réponse est souvent dépendante du contexte sinon on ne demanderait pas à longueur de temps un fichier.
De plus souvent même avec un fichier le répondeur n'est pas fichu d'adapter et de transposer la réponse donnée qui fonctionne sur son vrai fichier.
Et ici il faut répondre à l'aveugle sans connaitre le contexte décidément cette nouvelle année déborde de surprise.
Les demandeurs sont de plus en plus fort !!!

Demain j'irais voir mon banquier pour lui demander si c'est possible de me faire un pret sans connaitre ma situation, ni l'objet, ni le montant etc .....MDR pour voir sa tête et sa réponse.

@Phil69970

 

[Dranreb]

Qu'est-ce que vous n'avez pas compris ?
Le module que je vous ai proposé permet de considérer PressePapier comme une variable correspondant au presse-papier. Y affecter un String revient donc à un Ctrl+C sur un bout de texte sélectionné, l'y en récupérer un équivaut à un Ctrl+V.

 

[Dranreb]

En tout cas le contexte que j'ai compris est assez simple vu qu'il s'agit seulement de coller dans la cellule active en tant que montant un texte numérique préalablement copié depuis une application externe.

Option Explicit
Private Sub CBnColler_Click()
   Dim Z As String
   Z = PressePapier
   If IsNumeric(Z) Then
      ActiveCell.Value = CCur(Z)
   Else
      MsgBox """" & Z & """ n'est pas convertible en montant.", vbCritical, "CBnColler"
      End If
   End Sub

Attention, c'est la virgule qui est supposée être le séparateur décimal dans le texte copié.