XLS - Oddelovac pri ulozeni do csv

[Stevik]

Diky moc! Moc mi to pomuze, uz se s tim drbu tyden.

[Reklama]

[mike007]

Tak bohužel má Mikel pravdu. Nepodařilo se mi "ochcat" VBA, aby soubor uložil se středníky a to jsem dělal opravdu "psí kusy." Tak snad se najde někdo s jinou procedurou, jak kýženého výsledku docílit.

Zkus se zeptat ještě tady : http://pandora.idnes.cz/conference/excel/.
Tam by mohl někdo přijít s řešením.

[Stevik]

Nepovedlo, ale i tak diky ....

[Stevik]

Zkusil jsem si to poskladat do jednoho sloupce =a1&";"&b1&";"&c1& ..... pak ulozim jako txt, uz je to skoro ono, jen radek v textaku ma na zacatku a na konci uvozovky - tedy dotaz 2 - lze VBA rici, ze je tam nema davat?

[X]

Tak největší kapacity na Excel jsou na této e-mailové konferenci, jestli se to někomu podaří, tak jim ...

http://www.pandora.cz/conference/excel

[mike007]

X :Taky neznají všechno. Tehdy jsem se je ptal na dvě věci, které jsem nedokázal vyřešit a nepomohli mi

[mike007]

Zkusil jsem si to poskladat do jednoho sloupce =a1&";"&b1&";"&c1& ..... pak ulozim jako txt, uz je to skoro ono, jen radek v textaku ma na zacatku a na konci uvozovky - tedy dotaz 2 - lze VBA rici, ze je tam nema davat?

Nezjistil jsem, jak do csv uložit data se středníky, ale do textového souboru to lze. Tady je makro :

Kód: Vybrat vše

Public Sub ExportDoTextu(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String


Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
End If

If AppendData = True Then
    Open FName For Append Access Write As #FNum
Else
    Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
        If Cells(RowNdx, ColNdx).Value = "" Then
            CellValue = Chr(34) & Chr(34)
        Else
           CellValue = Cells(RowNdx, ColNdx).Text
        End If
        WholeLine = WholeLine & CellValue & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

'potvrdime uspesnost akce
MsgBox "Export dat do textového souboru byl proveden.", vbInformation + vbOKOnly, "Hotovo"

End Sub

Sub data_do_txt()
'zadame nazev txt souboru pro export dat
jmenotxt = InputBox("Zadej název tetového souboru pro export dat :", "Název")
If jmenotxt = "" Then
MsgBox "Musíš zadat název!", vbCritical + vbOKOnly, "Chybí název!"
Else
    ExportDoTextu FName:="E:\" & jmenotxt & ".txt", Sep:=";", _
       SelectionOnly:=False, AppendData:=True
End If
End Sub



Otevřeš si xls soubor ( třeba ten cos mi posílal přes SZ ) a spustíš makro. Do otevřeného okna zadáš název textového dokumentu a potvrdíš. Výsledek budeš mít na E:\

[Stevik]

SUPER! Diky moc, vyzkousim!

[Stevik]

Funguje Diky!