• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

No tak vysvětlili jste mi to oba pěkně.Teoreticky to už chápu,ale jak to napsat,tak to je pro mě neřešitelný problém.Tady záznamník asi nepomůže.Nemůžete mě nakopnout třeba nějakým kodem,kde to je a že bych to zkusil najít?

Ahoj Mišočko,tedy jedním stiskem jednoho tlačítka to neudělám?Studovat to nemusíš,jen bych potřeboval vědět,jak na to.Makro se mi zastaví po zkopírování na první list.Jak mu tedy mám říct,aby pokračovalo dál.To právě nevím.

Private Sub CommandButton1_Click() '++++++++++++++++++++++++++++++++++++++++ import csv.souboru-odkud kam
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;\\Freenas\Hdd1\Excell\dataexport.csv", Destination:=Range("Import!$A$1") _
)
.Name = "dataexport"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1250
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False


Range("C:C,D:D,P:P,Q:Q,R:R").Select '+++++++++++++++++++++++++++++++Vybere sloupce C:D,smaže obsah bunek a odstraní sloupce
Selection.ClearContents
Selection.Delete Shift:=xlToLeft

Columns("B:B").Select '+++++++++++++++++++++++++++++++Vybere B sloupec a nastaví formát datumu
Selection.NumberFormat = "m/d/yyyy"

Columns("R:R").Select '++++++++++++++++++++++++++++++++přehození prvního a posledního sloupce
Range("R1").Activate
Selection.Copy
Columns("S:S").Select
Range("S1").Activate
ActiveSheet.Paste
Columns("R:R").Select
Range("R1").Activate
Application.CutCopyMode = False
Selection.ClearContents
Columns("A:A").Select
Selection.Copy
Columns("R:R").Select
ActiveSheet.Paste
Columns("S:S").Select
Application.CutCopyMode = False
Selection.Copy
Columns("A:A").Select
ActiveSheet.Paste
Columns("S:S").Select
Application.CutCopyMode = False
Selection.ClearContents



Dim PWsht As Worksheet, PBlk As Range, PCll As Range, PFRw As Range
Dim AWsht As Worksheet, ABlk As Range, AFRw As Range, AOfsR As Long
Dim i As Long
' definice bloku
Set PWsht = ActiveWorkbook.Worksheets("Import") ' list
Set PFRw = PWsht.Range("a1:r1") ' prvni radek
Set AWsht = ActiveWorkbook.Worksheets("Klienti")
Set AFRw = AWsht.Range("a1:r1")
' blok zaznamu na listu prepis
With PWsht
If Len(.Range("a1").Value) > 0 Then
' pocet radku obsahujicich zaznamy na listu prepis
i = 0
For Each PCll In .Range("a1:a500").Cells
If Len(PCll.Value) > 0 Then i = i + 1
Next PCll
' definovat blok zaznamu na listu prepis
Set PBlk = PFRw.Resize(i, PFRw.Columns.Count)
' nastavit ofset pro prvni volny radek na listu archiv
With AWsht
If Len(.Range("a1").Value) = 0 Then
Set ABlk = AFRw
Else
Set ABlk = .Range("A1:R" & .Cells(1, 1).End(xlDown).Row)
End If
AOfsR = ABlk.Rows.Count ' ofset prvniho volneho radku
End With
' prenest zaznamy z listu prepis na list archiv
AFRw.Resize(i, AFRw.Columns.Count).Offset(AOfsR, 0).Value = PBlk.Value
Else
MsgBox "Na listu prepis nejsou zaznamy k prevodu do archivu"
End If
End With
' odstranit objektove promenne
Set PWsht = Nothing
Set PBlk = Nothing
Set PCll = Nothing
Set PFRw = Nothing
Set AWsht = Nothing
Set ABlk = Nothing
Set AFRw = Nothing

End With
End Sub

Zdravím,mám udělané makro,které mi provede import dat z csv.souboru,pak mi odstraní nepotřebné sloupce a přehodí pořadí sloupců.Pak mi list nakopíruje do jiného listu do prvního volného řádku.Nedaří se mo ho donutit,aby mi to kopírovalo ještě do dalšího listu.Tedy do dvou listů najednou.Poradí někdo,co v kodu upravit?
Dík za případnou pomoc.
[ Private Sub CommandButton1_Click() '++++++++++++++++++++++++++++++++++++++++ import csv.souboru-odkud kam
Application.ScreenUpdating =

Tak jsem zas o něco moudřejší.Moc ti děkuju za pomoc a hlavně za radu.Ještě jednou dík.

Skvělá práce,nenapadlo by mě to...jen ještě malý dotaz,když např. je 3-ciferné číslo,je možné tam mít místo prvního čísla dvojitou čáru?jde o list k vyplnění poštovní složenky,kde nevyplněné pole musí být proškrtnuté.
Ale i takhle je to super a dík za to.

Zdravím,zná někdo funkci,která dokáže rozdělit číslo v bunce do více buněk?Příklad:v bunce A1 bude číslo třeba 1243.Do bunky B1 by se vložilo 1,do bunky C1 by se vložilo 2,do bunky D1 by se vložilo 4 a do bunky E1 by se vložilo 3.
Zkoušel jsem tom pomocí funkce ZLEVA A ZPRAVA.Číslo jsem si rozložil,ale vzniká tam problém,když zadám např.10,tak mi vychází 1000..
Je taková funkce,která by to uměla?
Dík za případnou radu,nebo pomoc.

Takže věc se má asi takhle.Data do bunky H3 si beru z Comboboxu3 takto:Cells(3, 8).Value = ComboBox3.Value
Při tomto zadání makro nefunguje.
Pokud data do bunky H3 zadám ručně,makro funguje.Co s tím?Jak jinak ta data dostat do té bunky H3?

Chlapi,nebude problém tady v tom?
Filename:=Left(Jmeno, Len(Jmeno) - 1)
Nerozumím tomu,ale nezdá se mi to.

No tak já nevím...tvá ukázka funguje,nakopčím do mého sešitu a nic.Zase to nezobrazí název pro uložení..Sešit bych rád poslal,ale nemůžu,protože je to obludně velké.Má to 1,5Mb.Musel bych jedině na mail.

Asi dělám něco špatně.Mužeš to zkusit?
Dim Cesta As String
Dim Jmeno As String

' nastavit cestu
Cesta = "C:\Excell\"
ChDir Cesta

'ulozeni listu 1
Sheets("Dopis1").Select
Jmeno = Application.GetSaveAsFilename(Worksheets("Dopis1").Range("H5") & ("-Dopis"))

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Left(Jmeno, Len(Jmeno) - 1), Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

'navrat na prvni list
Worksheets("Start").Activate


End Sub


Jak to dáváte do toho Code?

to Pavlus:Nefunguje..otevře nabídku na uložení,ale nevypíše název souboru.

To se mi právě nedaří.Většinou píše chybná syntaxe.

Opět zdravím.mám makro,které mi ukládá zvolený list(v tomto případě list DOPIS)pod názvem podle hodnoty z bunky H5 a k tomu přidává do názvu text dopis.Je to kvůli pozdějšímu rozkišení.Ještě bych potřeboval,aby to bralo data z další bunky(H3).Je to možné?Nedaří se mi to do makra zakomponovat.Přikládám část makra.Děkuji za případnou radu.
Jmeno = Application.GetSaveAsFilename(Worksheets("Dopis1").Range("H5") & ("-Dopis"))

Miško,máš to v mailu.Dík.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse