Snel pipetekens maken

[tshw3]

De PutInClipboard methode werkt niet als er een Windows verkenner venster open staat.

Dat was de truc, dan werkt het inderdaad!

 

[tshw3]

Dan gaat er aan jouw kant toch wel iets mis:
Je moet de macro in de macromodule van het aktieve blad zetten.
en gebruik in de Editor F8 om de macro stap-voor-stap uit te voeren en de waarden van variabelen te zien.
Debugging is het voorrecht van de vragensteller.

Sub M_snb_001()
  sn = Cells(1).CurrentRegion
   
  For j = 1 To UBound(sn)
    c00 = c00 & "|" & sn(j, 1)
  Next
   
  CreateObject("scripting.filesystemobject").createtextfile("C:\Users\Teun\pijp.txt").write c00
  msgbox dir("C:\Users\Teun\pijp.txt")
End Sub

Dit blijkt toch nog niet helemaal goed te werken, als er meer waardes in het bestand staan zie onderstaande foto:


In bovenstaand test voorbeeld gebruikte ik 31 regels, de kopie naar klembord blijft wel werken.

 

[AHulpje]

Om het eerste pipe symbool weg te laten wijzig je

[COLOR=#333333]   For j = 1 To UBound(sn)
[/COLOR]     c00 = c00 & "|" & sn(j, 1)
   Next

in

[FONT=Verdana]  coo=sn(1,1)
[/FONT][COLOR=#333333]  For j = 2 To UBound(sn)[/COLOR]
    c00 = c00 & "|" & sn(j, 1) 
[COLOR=#222222][FONT=Verdana]next
[/FONT][/COLOR]

Om het bestand in dezelfde map als het Exceldocument te laten opslaan, zie bericht #12

 

[tshw3]

Ah excuus, post 12 heb ik over het hoofd gezien...

Vanuit mijn onedrive folder werkt het niet, vanuit downloads folder wel (oftewel kan geen netwerkfolder zijn) dat is overigens geen probleem.
Ik zou ook graag willen dat het wordt geopend na uitvoering:

Sub PipeExport()
    Dim PipeFile
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set PipeFile = FSO.CreateTextFile(ActiveWorkbook.Path & "\Pipefile.txt")

    sn = Cells(1).CurrentRegion
   
    For j = 1 To UBound(sn)
        PipeFile.Write "|" & sn(j, 1)
    Next
   
    PipeFile.Close
    MsgBox "Resultaat in " & ActiveWorkbook.Path & "\Pipefile.txt"
    returnvalue = Shell("notepad.exe " & " & ActiveWorkbook.Path & "\Pipefile.txt", vbNormalFocus)
End Sub

Met de returnvalue moet ik nog even spelen omdat dit nog niet werkt, voor w.b.t. aanpassing om eerste pipeteken niet te krijgen. Dit werkt bij mij niet?

Edit
Overigens doet dit script hetzeflde, bij meer waardes in kolom A dus bijvoorbeeld 50 waardes dan komen er allerlei chinese karakters i.p.v. het juiste filter.

mvg,
Teun

 

[AHulpje]

Je had bericht #23 met #12 moeten combineren, in onderstaande code heb ik dat voor je gedaan.
Tevens een foutje uit je laatste coderegel verwijderd.

Sub PipeExport()
    Dim PipeFile
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set PipeFile = FSO.CreateTextFile(ActiveWorkbook.Path & "\Pipefile.txt")


    sn = Cells(1).CurrentRegion
   
    PipeFile.Write sn(1, 1)
    For j = 2 To UBound(sn)
        PipeFile.Write "|" & sn(j, 1)
    Next
   
    PipeFile.Close
    MsgBox "Resultaat in " & ActiveWorkbook.Path & "\Pipefile.txt"
    returnvalue = Shell("notepad.exe " & ActiveWorkbook.Path & "\Pipefile.txt", vbNormalFocus)
End Sub

 

[tshw3]

Je had bericht #23 met #12 moeten combineren, in onderstaande code heb ik dat voor je gedaan.
Tevens een foutje uit je laatste coderegel verwijderd.

Sub PipeExport()
    Dim PipeFile
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set PipeFile = FSO.CreateTextFile(ActiveWorkbook.Path & "\Pipefile.txt")


    sn = Cells(1).CurrentRegion
   
    PipeFile.Write sn(1, 1)
    For j = 2 To UBound(sn)
        PipeFile.Write "|" & sn(j, 1)
    Next
   
    PipeFile.Close
    MsgBox "Resultaat in " & ActiveWorkbook.Path & "\Pipefile.txt"
    returnvalue = Shell("notepad.exe " & ActiveWorkbook.Path & "\Pipefile.txt", vbNormalFocus)
End Sub

Dit werkt perfect! Ik ga analyseren wat precies de verschillen zijn.
Grote dank en doet precies wat ik wil.

Nog een fijne dag!