Ouverture et modification de fichier * txt dans une macro VB

Question

Bonjour,

Je viens souvent voir ce site dès que j'ai besoin d'un petit coup de main, mais aujurd'hui je sèche... ca fait 1 heure que je gratte mais je ne trouve aucun code satisfaisant. Pourriez-vous m'aider.

J'ai un fichier excel, après une macro de mise à jour je souhaite copier un certain nombre de cellules pour pouvoir les coller dans un fichier *txt qui me sert ensuite de base de donnée pour lancer une recherche dans un logiciel.  

J'en suis ici: 

Range("B2").Select
Range(Selection, Selection.End(xlDown)).Copy

Et maintenant je voudrais ouvrir le fichier "C:\Documents and Settings\lopesc\Desktop\SAP_Temp.txt", le vider totalement ( ex: Ctrl+A ; suppr) et y coller les cellules copiées plus haut.
Ensuite enregistrer le fichier et le fermer.

Voila j'espère que vous m'aiderez. 

Merci à tous pour vos aides si prévieuse disponible ici.

Renfield · Answer

en gros :

open "C:\Documents and Settings\lopesc\Desktop\SAP_Temp.txt" For Output As #1
Print #1,,ClipBoard.GetText
close #1

Renfield · Answer

(après avoir copié les données, bien entendu)

whitelegend030 · Answer

open "C:\Documents and Settings\lopesc\Desktop\SAP_Temp.txt" For Output As #1

Print #1,,ClipBoard.GetText

close #1

la macro plante ici, pourtant les données sont bien copiées à ce stade j'ai vérifié

whitelegend030 · Answer

oui j'aurais du aussi mettre le message d'erreur ... xD ca aiderait je pense:

Erreur d'éxécution '424':

Objet requis

whitelegend030 · Answer

En parcourant internet il me semble que le code que tu m'as donné ressemblerait a un code " VBScript" .... je dis ca car il me semble avoir compris que c'était ca quand on voyait des " # ". Au cas ou tu ne l'aurais pas vu je suis plutot très novice ... ^^" Je vais te mettre la macro que je me susi faite j'espère que tu ne vas pas vouloir me tuer en voyant ca, car ca doit surement être horrible pour des avertis ... J'ai mis ton code à la fin dans l'attribut " line53" voila j'espère que vous allez pourvoir m'aider. merci d'avance ************************************************************************************************ Sub Macro_NCR() 'Macro pour mettre à jour le tableau à partir de l'ABAP SAP ' ' 'Règle de recherche SAP: 'CREATED BY: "LOPESC" 'VARIANT NAME: "LOPESC NOQA" 'Short Description: "ALL NCR SEARCH without QA" ' ' ' 'Test de départ avant lancement de la macro si l'ABAp est bien présent dans la feuille "(MàJ journalière)" Sheets("(MàJ journalière)").Select If Range("B2").Value = "" Then GoTo line50 'Renvoie à la fin de la macro car ABAP manquant Else GoTo line51 'Renvoie sur la suite de la macro pour éxécution End If line51: 'Actualiser calculs Calculate Sheets("Clôturés").Select Selection.AutoFilter Field:=18, Criteria1:="<>" ActiveSheet.ShowAllData 'Traitement des dates dans MàJ Sheets("(MàJ journalière)").Select Columns("I:J").Select Selection.NumberFormat = "[$-40C]d-mmm-yy;@" 'donne à la variable "q" le nombre de lignes utilisées dans la feuille MàJ Range("B2").Select line10: If Range("B2").Value <> "" Then GoTo line11 Else GoTo line12 line11: q = Selection.Row If Range("B" & q + 1).Value <> "" Then Range("B" & q + 1).Select GoTo line10 End If line12: End If 'traitement des dates de modifications For s = 2 To q Range("L" & s).FormulaR1C1 = "=LEFT(RC[-3],5)" 'extrait les 5 1er caractères de la colonne "modifié le" et les colle en colonne "L" Range("M" & s).FormulaR1C1 = "=LEFT(RC[-1],2)" 'extrait les 2 1er caractères de la colonne "L" et les colle en colonne "M" Range("N" & s).FormulaR1C1 = "=RIGHT(RC[-2],2)" 'extrait les 2 derniers caractères de la colonne "L" et les colle en colonne "N" Range("O" & s).FormulaR1C1 = "=RIGHT(RC[-6],4)" 'extrait les 4 derniers caractères de la colonne "Modifié le" et les colle en colonne "O" Range("T" & s).FormulaR1C1 = "=DATE(RC[-5],RC[-6],RC[-7])" 'Traduit la date de modification au bon format dans la colonne "T" 'traitement des dates de créations Range("P" & s).FormulaR1C1 = "=LEFT(RC[-6],5)" 'extrait les 5 1er caractères de la colonne "Crée le" et les colle en colonne "P" Range("Q" & s).FormulaR1C1 = "=LEFT(RC[-1],2)" 'extrait les 2 1er caractères de la colonne "P" et les colle en colonne "Q" Range("R" & s).FormulaR1C1 = "=RIGHT(RC[-2],2)" 'extrait les 2 derniers caractères de la colonne "P" et les colle en colonne "R" Range("S" & s).FormulaR1C1 = "=RIGHT(RC[-9],4)" 'extrait les 4 derniers caractères de la colonne "crée le" et les colle en colonne "S" Range("U" & s).FormulaR1C1 = "=DATE(RC[-2],RC[-3],RC[-4])" 'Traduit la date de création au bon format dans la colonne "U" Next 'remplace les dates dans l'ABAP Range("T2" & ": U" & q).Select Selection.Copy Range("I2").Select Application.Run "'Tableau de suivi des Ncr.xls'!Collage_spécial" 'copier les cloturés depuis OUVERTS Sheets("Ouverts").Select Selection.AutoFilter Field:=1, Criteria1:="=" Sheets("Ouverts").Select Range("B1:M1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy 'Coller les clôturés au fond de la feuille CLOTURES Sheets("Clôturés").Select Range("A1").Select Selection.End(xlDown).Select num_ligne = Selection.Row + 1 Range("A" & Selection.Row + 1).Select x = 0 y = Selection.Row Application.Run "'Tableau de suivi des Ncr.xls'!Collage_spécial" 'Supprimer la ligne de titres Rows(num_ligne).Select Selection.Delete 'Modifie les dates de modifications des nouveaux clôturés line1: If Range("I" & y).Value <> "" Then GoTo line2 Else GoTo Line3 End If line2: Range("H" & y).Value = Date Range("H" & y).Select x = x + 1 y = y + 1 GoTo line1 'Retourne à la 1ère ligne des nouveaux clôturés Line3: x = x - 1 Range("I" & Selection.Row - x).Select 'Déplace les commentaires des clôturés Range("K" & Selection.Row).Select Range("K" & Selection.Row & ": K" & Selection.Row + x).Select Selection.Copy Range("O" & Selection.Row).Select Application.Run "'Tableau de suivi des Ncr.xls'!Collage_spécial" 'Ecrit la date de clôture dans les commentaires Range("K" & Selection.Row & ": K" & Selection.Row + x).Select Selection.NumberFormat = """Clôturé le ""[$-40C]d-mmm-yy;@" Selection.Value = Date 'Ecrit les dates de clôture dans la colonne de calcul t = 0 Range("N" & Selection.Row).Select line4: If Range("L" & Selection.Row).Value <> "" Then Selection.Value = Date Range("N" & Selection.Row + 1).Select t = t + 1 If t <= x Then GoTo line4 Else Selection.Value = "----------------" Range("L" & Selection.Row).Value = "----------------" Range("N" & Selection.Row + 1).Select t = t + 1 If t <= x Then GoTo line4 End If Range("N" & Selection.Row - x - 1).Select 'Actualiser calculs Calculate 'Supprimer les cloturés dans feuille OUVERTS Sheets("Ouverts").Select For i = 2 To 1000 If Range("A" & 1002 - i) = "" Then If Range("O" & 1002 - i).Value <> "" Then Rows(1002 - i).Delete End If Next 'Actualiser calculs Calculate 'copier les nouveaux ouverts depuis MàJ JOURNALIERE Sheets("Ouverts").Select Selection.AutoFilter Field:=1 Sheets("(MàJ journalière)").Select Selection.AutoFilter Field:=1, Criteria1:="=" Sheets("(MàJ journalière)").Select Range("B1:K1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy 'Coller les Nouveaux ouverts au fond de la feuille OUVERTS Sheets("Ouverts").Select Range("B1").Select Selection.End(xlDown).Select num_ligne = Selection.Row + 1 Range("B" & Selection.Row + 1).Select Application.Run "'Tableau de suivi des Ncr.xls'!Collage_spécial" 'Supprimer la ligne de titres Rows(num_ligne).Select Selection.Delete 'Remplacer les "." par des "/" dans les dates des nouvreaux NCR Columns("I:J").Select Selection.NumberFormat = "[$-40C]d-mmm-yy;@" Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False 'Actualiser calculs Calculate 'Supprimer les cloturés dans feuille OUVERTS Sheets("Ouverts").Select For i = 2 To 1000 If Range("O" & 1002 - i).Value <> "" Then Rows(1002 - i).Delete Next 'Actualiser calculs Calculate 'reclasse la feuille OUVERT par ordre croissant Range("A1:O865").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'Nettoyage de la feuille MàJ JOURNALIERE Sheets("(MàJ journalière)").Select ActiveSheet.ShowAllData Range("B2:U2").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("B2").Select 'Actualisation des Database et des Graphiques Sheets("Database1").Select Range("A2:C2").Select Selection.AutoFill Destination:=Range("A2:C1000") Range("A2:C1000").Select 'Actualiser calculs Calculate Sheets("Répartition des NCR par dates").Select ActiveChart.PivotLayout.PivotTable.RefreshTable Sheets("Répartion des NCR par services").Select ActiveChart.PivotLayout.PivotTable.RefreshTable Sheets("Ouverts").Select GoTo line53 line50: 'message d'annulation de la macro car test de départ non concluant MsgBox ("Importer d'abord l'ABAP de SAP avant de lancer la macro") MsgBox ("Macro annulée") GoTo line53 line53: Sheets("Ouverts").Select Range("B2").Select Range(Selection, Selection.End(xlDown)).Copy Open "C:\Documents and Settings\lopesc\Desktop\SAP_Temp.txt" For Output As #1 Print #1, , ClipBoard.GetText Close #1 End Sub

cs_MPi · Answer

Renfield avait la bonne solution... encore...
Par contre le Clipboard n'est pas disponible en VBA comme il l'est en VB.

Essaie ceci

Dans un module, copie ceci (ça ne vient pas de moi, mais bon...)
Option Explicit

' API pour utiliser le ClipBoard
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

' Fonction pour utiliser le Clipboard
Function ClipBoard_GetData()
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim MyString As String
    Dim RetVal As Long
    
    If OpenClipboard(0&) = 0 Then
        MsgBox "Cannot open Clipboard. Another app. may have it open"
        Exit Function
    End If

    ' Obtain the handle to the global memory block that is referencing the text.
    hClipMemory = GetClipboardData(CF_TEXT)
    If IsNull(hClipMemory) Then
        MsgBox "Could not allocate memory"
        GoTo OutOfHere
    End If

    ' Lock Clipboard memory so we can reference the actual data string.
    lpClipMemory = GlobalLock(hClipMemory)
    If Not IsNull(lpClipMemory) Then
        MyString = Space$(MAXSIZE)
        RetVal = lstrcpy(MyString, lpClipMemory)
        RetVal = GlobalUnlock(hClipMemory)
        ' Peel off the null terminating character.
'        MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), vbBinaryCompare) - 1)
        MyString = Left(MyString, Len(MyString) - 1)
    
    Else
        MsgBox "Could not lock memory to copy string from."
    End If
    
OutOfHere:
    RetVal = CloseClipboard()
    ClipBoard_GetData = MyString
    
End Function

Puis dans feuille copie ce code pour tester
Inscris des valeurs dans une plage A1 à G10, disons
Option Explicit

Sub CopierCollerRangeDansFichier()
    Dim MyArray As Variant
    Dim nbLignes As Long, nbColonnes As Integer
    
    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row
    nbColonnes = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Range(Cells(1, 1), Cells(nbLignes, nbColonnes)).Copy
    MyArray = ClipBoard_GetData()
    
    Open "C:\TestCopie.txt" For Output As #1
        Print #1, MyArray
    Close #1
End Sub

MPi²

whitelegend030 · Answer

j'ai un peu de mal à comprendre je colle ces 2 codes dans 2 modules différents ? et je ne me sert que du second ?

de toutes facons quand j'éxécute le second module ca a pour effet de fermer mon classeur, quand je veux je re ouvrir excel me propose des versions récupérées suite à un plantage, et si je veux ouvrir mon original je ne peux pas car il est en lecture seul apparement bloqué par moi même ...

désolé de ne pas comprendre aussi rapidement que vous le souhaiteriez mais je suis réellement novice dans les macros je ne fait que me lancer dedans. La macro que j'ai posté ci-dessus est ma toute 1ère.

Renfield · Answer

ah, ok, pas de Clipboard en VBA, sorry...

j'applique :
http://word.mvps.org/FAQS/MacrosVBA/ManipulateClipboard.htm


ca donne (non testé) :

Dim oClipboard As DataObject
    Open "C:\Documents and Settings\lopesc\Desktop\SAP_Temp.txt" For Output As #1
        Set oClipboard = New DataObject
        oClipboard.GetFromClipboard
        Print #1, , oClipboard.GetText
    Close #1

whitelegend030 · Answer

voila la macro que j'ai faite pour tester :

Sub test()
Range("D2:D15").Copy
Dim oClipboard As DataObject
   Open "C:\Documents and Settings\lopesc\Desktop\SAP_Temp.txt" For Output As #1
        Set oClipboard = New DataObject
        oClipboard.GetFromClipboard
        Print #1, , oClipboard.GetText
    Close #1
    
End Sub

resultat:

         Erreur de compilation:

Type défini par l'utilisateur non défini

            OK               Aide

désolé de vous embéter :S

Renfield · Answer

ca coince où ? DataObject ?

Renfield
Admin CodeS-SourceS- MVP Visual Basic

cs_MPi · Answer

Pour utiliser le DataObject, il faut que tu références Forms 2.0

MPi²

whitelegend030 · Answer

Sub test()
Range("D2:D15").Copy
Dim oClipboard As DataObject
   Open "C:\Documents and Settings\lopesc\Desktop\SAP_Temp.txt" For Output As #1
        Set oClipboard = New DataObject
        oClipboard.GetFromClipboard
        Print #1, , oClipboard.GetText
    Close #1
    
End Sub

ca coince ici.

MPi je suis assez novice dans ce domaine, donc pour moi le: "
                        
                        Pour utiliser le DataObject, il faut que tu références Forms 2.0" c'est pas encore  du chinois mais au moins du javanais... :p

cs_MPi · Answer

Dans l'IDE d'Excel, là où tu codes...
Va dans le menu Outils, puis Références
Recherche et coche la référence
Microsoft Forms 2.0 Object Library

MPi²

cs_MPi · Answer

Et pour le code que j'ai mis avec les APIs, c'est cette procédure que tu dois appeler
CopierCollerRangeDansFichier
Mets le code de cette procédure dans le code d'une feuille et assure-toi que cette feuille est active et contient des données à copier.
Si tu mets le code dans un module, il faudrait éventuellement ajouter ActiveSheet ou le nom explicite de la feuille Sheets("Feuil1") avant les mots Range, Cells, ...

L'autre partie va dans un module standard (.bas), pas module de classe (.cls)
Et n'appelle rien dans cette partie, le code de CopierCollerRangeDansFichier va s'en charger.

MPi²

whitelegend030 · Answer

Tout compte fait un petit truc que je croyais pratique au départ se révèle vachement difficile T_T

Je vois, MPi, que tu as fait pleins d'efforts pour m'expliquer le plus simplement possible, mais le problème c'est que je suis encore plus novice que ca.... donc ( .bas) ou (.cls) ben la deja je susi perdu.

C'est dommage qu'il n'y ai pas de code tout simple dans VB comme un copier/coller ... xD

donc voila ou j'en suis.

whitelegend030 · Answer

Plus de signe de vie ici... T_T 

De l'aide s'il vous plait car sans vous je suis coincé...

Ouverture et modification de fichier * txt dans une macro VB

16 réponses

Votre réponse

Discussions similaires