Macro Copier coller d'Excel vers NOTEPAD

Version imprimable

Bonjour,

Voila mon problème. Je cherche à l'aide d'une macro a copier dans notepad les données d'une feuille excel.
Pour l'instant j'ai réussi ca
Code:

1 2 3 4 Id = Shell("notepad") '= ca m'ouvre bien le blocnote Sheets("repcpt").Select '= repcpt est bien le nom de l'onglet dans lequel je viens chercher mes informations Columns("A:A").Select '= je veux copier toute la colonne A Selection.Copy
et a partir de la ca coince, je n'arrive pas à lui dire de faire le coller dans le bloc note...
il faut bien sur ensuite que je sauvegarde le bloc note avec un nom spécifique...
Auriez-vous une idée.
Merci d'avance de votre aide

Bonsoir,

Tu as posté ta question dans le forum dédié à Excel en général et non celui dédié aux questions touchant au VBA.

A tester (copie les données de la plage A1:A50 de la feuille 1 dans NotePad) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Option Explicit
#If Win64 Then 'si Excel 64 bits
  Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
  Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
 
  Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
#Else 'si Excel 32 bits
  Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
  Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
 
  Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
 
Sub NotePad()
Dim wNotePad As Long, wEdit As Long, RetVal As Long
Dim Data As Range, Wsh As Object
 
Const Pause As Long = 200
 
RetVal = Shell("notepad", vbNormalFocus)
If RetVal = 2 Or RetVal = 3 Then Exit Sub
 
Do
  DoEvents
  wNotePad = FindWindow("Notepad", "Sans titre - Bloc-notes")
Loop Until wNotePad > 0
 
Sleep Pause
 
Set Data = Worksheets(1).Range("A1:A50")
Data.Copy
Sleep Pause
Set Wsh = CreateObject("WScript.Shell")
Wsh.SendKeys "^c"
Sleep Pause
wEdit = FindWindowEx(wNotePad, 0&, "Edit", vbNullString)
Sleep Pause
Wsh.SendKeys "^v"
Sleep Pause
Application.CutCopyMode = False
Set Wsh = Nothing
End Sub

Au besoin augmenter le temps de la constante Pause en la passant à 400 (par exemple).

A+

29/10/2015, 19h54
Marc-L

Bonjour, bonjour !

Pas besoin de Notepad ‼ Via Enregistrer sous et sélectionner un format texte …

Effectivement, voir les nombreux exemples dans le bon forum …

______________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse
30/10/2015, 10h17
BABETH77

Bonjour,

En fait si j'ai vraiment besoin de notepad parce que ma ligne dans Excel est comme ceci
515006;7871 ;000000000120.42000;000000000000.00000;C0;20151014;
Quanf je fais sauvegarder sous..et que j'ouvre le fichier sous le bloc note ca me rajoute des guillemets
"515006;7871 ;000000000120.42000;000000000000.00000;C0;20151014;"
ce qui fait que je ne peux plus me servir de ce fichier pour l'intégrer dans un autre de mes outils de travail.
Par contre le copier coller ne m'ajoute pas de guillemets.
Merci de ta réponse.
Ps : Est-il possible de déplacer cette conversation dans le bon forum...désolée pour l'erreur....

Bonjour,
dans ce cas pas besoin de tout ça, stocke tes données dans un tableau et écris-les directement dans le fichier texte.
Admettons que ton fichier existe déjà (nommé test.txt dans l'exemple) : tu l'ouvres en mode écriture (ce qui écrasera le contenu actuel) et tu remplaces les données inscrites dedans par les nouvelles :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub test() Dim intFic As Integer, T(2) As String T(0) = "515006;7871 ;000000000120.42000;000000000000.00000;C0;20151014;" T(1) = "autre ligne" T(2) = "515006;7871 ;000000000120.42000;000000000000.00000;C0;20151013;" intFic = FreeFile Open "C:\Users\xxx\Desktop\test.txt" For Output As intFic 'nom du fichier à adapter For i = LBound(T) To UBound(T) Print #intFic, T(i) Next i Close intFic End Sub
C'est un exemple mais on peut faire autrement (c'est juste pour que tu comprennes le principe).
A+

30/10/2015, 11h28
BABETH77

Bonjour,

Merci beaucoup, ca fontionne correctement et j'obtiens bien le résultat voulu. (je viens de voir ton autre message mais je ne suis pas sure que ca aurait fonctionné, mon fichier excel a des données qui se mettent a jour et ce n'est donc jamais les mêmes codes et montants qui apparaissent) du coup celui-ci a résolu ma demande. Encore une petite chose si possible, une fois que mon fichier est rempli sous NOTEPAD, je voudrais pouvoir le sauvegarder avec un nom spécifique (genre repcpt.txt) a partir toujours de la macro. est-ce que cela est possible ? Merci encore de ton aide
30/10/2015, 11h49
davido84

Citation:

Merci beaucoup, ca fontionne correctement et j'obtiens bien le résultat voulu. (je viens de voir ton autre message mais je ne suis pas sure que ca aurait fonctionné, mon fichier excel a des données qui se mettent a jour et ce n'est donc jamais les mêmes codes et montants qui apparaissent)

Mais si justement ! Là ce n'est qu'un exemple basique mais au lieu de noter en dur les différentes données dans le code il te suffit de stocker les contenu de la colonne A dans une variable tableau ou Range au début du code.
Les éléments que tu copieras dans le fichier texte seront donc ceux qui sont actualisés.
Concernant la manipulation des fichiers texte regarde et étudie ce lien, notamment la partie traitant des fichiers texte pour comprendre le principe.
A+
30/10/2015, 14h26
Invité

Bonjour,
http://www.developpez.net/forums/d15...v/#post8307190

Un exemple vite fait :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
Dim intFic As Integer, R As Range, ws As Worksheet
Set ws = Sheets("Feuil1")'à adapter
 
Set R = ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp))
intFic = FreeFile
Open "C:\Users\xxx\Desktop\test.txt" For Output As intFic 'nom du fichier à adapter
 
For i = 1 To R.Rows.Count
  Print #intFic, R.Cells(i, 1).Value
Next i
 
Close intFic
End Sub

A+

RE bonjour,

bon la je crois que je suis complètement perdue.....
Voila pour l'instant le code que j'ai réussi a mettre (avec ta grande aide..merci)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Option Explicit
#If Win64 Then 'si Excel 64 bits
  Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
  Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
 
  Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
#Else 'si Excel 32 bits
  Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
  Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
 
  Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
 
 
Sub M_balance_repcpt()
'
' M_Balance_Repcpt
'
 
'
        Sheets.Add
    ActiveSheet.Name = "repcpt"
    Sheets("Repcpt1").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("repcpt").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("repcpt").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("repcpt").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("repcpt").Sort
        .SetRange Range("A1:A1687")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Dim wNotePad As Long, wEdit As Long, RetVal As Long
    Dim Data As Range, Wsh As Object
 
    Const Pause As Long = 200
 
    RetVal = Shell("notepad", vbNormalFocus)
    If RetVal = 2 Or RetVal = 3 Then Exit Sub
 
    Sleep Pause
 
    Set Data = Sheets("repcpt").Columns("A:A")
    Data.Copy
    Sleep Pause
    Set Wsh = CreateObject("WScript.Shell")
    Wsh.SendKeys "^c"
    Sleep Pause
    wEdit = FindWindowEx(wNotePad, 0&, "Edit", vbNullString)
    Sleep Pause
    Wsh.SendKeys "^v"
    Sleep Pause
    Application.CutCopyMode = False
    Set Wsh = Nothing
 
End Sub

Donc la mon bloc note est bien ouvert, les lignes de mon fichier excel sont bien copier dedans. Pour l'instant il s'appelle toujours "sans titre"
Je peux manuellement faire "fichier" enregistrer sous = > C:\TEMP\repcpt.txt mais en fait je voudrais pouvoir ecrire ca a la suite (je pense) aprés le set Wsh = Nothing....
Je ne sais pas si mes questions ou interrogations sont pertinentes, je ne fais pas souvent du VBA...j'espère ne pas trop monopoliser de ton temps.

30/10/2015, 16h08
davido84

Tu mélanges tout là !

Oublie le 1er code et utilise le dernier code fourni (Sub Test).
Crée un fichier texte sans rien dedans sur ton bureau (c'est pour l'exemple) et nomme-le "test.txt".

Les données à recopier dedans sont dans la colonne A de la feuille 1 (nommée "Feuil1") de ton fichier Excel.
Si la feuille porte un autre nom modifier le code en conséquence ligne Set ws = Sheets("Feuil1")'à adapter.

Modifie le chemin du fichier en y plaçant le tien dans la ligne Open "C:\Users\xxx\Desktop\test.txt" For Output As intFic 'nom du fichier à adapter.

Lance la macro.

Ouvre ensuite ton fichier texte et tu trouveras l'ensemble des données de la colonne A dans le fichier.

A+
30/10/2015, 17h21
Invité

Dans mon lien il y a même un fichier d'exemple!

heu....

bonjour
un exemple tu peut meme choisir le sens

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub sauve_colA()
tablo = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
fichier = ThisWorkbook.Path & "\copie de " & ActiveSheet.Name & " colonne A.txt"
'***************
sens = ";"
'sens = ";" & vbCrLf ' débloquer cette ligne pour transcrire verticalement dans le fichier .txt
'******************
For i = 1 To UBound(tablo)
texte = texte & tablo(i, 1) & sens
Next
x = FreeFile
Open fichier For Output As #x
Print #x, texte
Close #x
End Sub

29/10/2025, 13h35
rufian

Un exemple qui fonctionne avec choix du nom de sauvegaarde

Private Sub BtnNotepad_Click()
Dim WshShell As Object
Dim CheminBureau As String
Dim NomFichier As String
Dim FichierComplet As String
Dim MaPlage As Range
Set MaPlage = ThisWorkbook.Sheets("Feuil1").Range("A:D") 'A ADAPTER SELON VOS BESOIN

' Crée un objet WScript.Shell
Set WshShell = CreateObject("WScript.Shell")
' Récupère le chemin du bureau ' ADAPTER VOTRE EMPLACEMENT
CheminBureau = WshShell.SpecialFolders("Desktop")
' Demande à l'utilisateur le nom du fichier
NomFichier = InputBox("Sauver sous quel nom ?", "Entrez un nom de fichier (sans espace)")
' Vérifie si un nom a été entré
If NomFichier = "" Then
MsgBox "Aucun nom de fichier saisi. Opération annulée.", vbExclamation
Exit Sub
End If
' Crée le chemin complet du fichier
FichierComplet = CheminBureau & "" & NomFichier & ".txt"
' Sauvegarde la plage dans le fichier texte
Call TxtPlage(FichierComplet, MaPlage)
' Ouvre le fichier dans le Bloc-notes
WshShell.Run "notepad.exe """ & FichierComplet & """"
' Nettoyage
Set WshShell = Nothing
End Sub

Sub TxtPlage(ByVal RéfFic As String, ByVal Plg As Range)
Dim Te As Variant
Dim Ts() As String
Dim L As Long, C As Long

Te = Plg.Value
ReDim Ts(1 To UBound(Te, 2))

Open RéfFic For Output As #1
For L = 1 To UBound(Te, 1)
For C = 1 To UBound(Te, 2)
Ts(C) = Te(L, C)
Next C
Print #1, Join(Ts, vbTab)
Next L
Close #1
End Sub
29/10/2025, 20h12
Nain porte koi

Pas mal le déterrage... 10 ans, sur une discussion résolu en plus :D

PS : le bouton # sert à mettre le code plus proprement