Možno si tam nájdete nejakú inšpiráciu. Netuším, čo to chcete vlastne robiť s tými súbormi ... preto je to len tak z brucha ...
Příloha: 
31505_pomoc-s-makrom.zip (35kB, staženo 19x)
citovat31505_pomoc-s-makrom.zip (35kB, staženo 19x)
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: VBA propojení ovládacích prvků
MS Excel
Téma: VBA propojení ovládacích prvků 
Zaslal/a 12.5.2016 21:45
Ahoj,
s VBA pomaličku začínám a teď pracuji na prvním větším pokusu o takové hodnotnější marko a narazil jsem na několik problémů a rád bych Vás poprosil o radu, jelikož jsem nic podobného nikde nenašel.
Rád bych udělal "ovládací menu" makra, kde bych první musel zadat zdrojový .xslx z daného adresáře, poté vyberu pomocí option boxu danou variantu a zapnu makro. Povedlo se mi načíst data z adresáře, ale neumím je propojit s dalším prvkem, tj. jak vybrat zdrojový soubor a jak ho zapsat do daného marka jako proměnný zdroj. Je to možné?
Private Sub CommandButton1_Click()
adresar = "C:\Users\..."
ChDir adresar
SouboryKtere = Dir("*.*")
ListBox1.Clear
Do While SouboryKtere <> ""
ListBox1.AddItem SouboryKtere
SouboryKtere = Dir
Loop
If OptionButton1.Value = True Then
Call Module1.VyberData1
Call Module1.Format1
End If
If OptionButton2.Value = True Then
Call Module1.VyberData2
Call Module1.Format2
End If
End Sub
Dále bych potřeboval přímo v samotném makru nastavit podmínku, když je přímo v option boxu zvolena 1. možnost a je již vygenerovaný požadovaný soubor, tak při volbě a generování 2. možnosti se nevytvářel nový .xslx, ale přidal se pouze nový list.
Set sesit = Workbooks.Add
sesit.SaveAs Filename:="C:\Users.... " & Date & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Set list = Workbooks("Data " & Date & ".xlsx").Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'přídání listu na konec
list.Name = "Data1" '& Hour (Time) & Minute (Time)
list.Tab.Color = RGB(255, 255, 200)
Set kde = Workbooks("Data " & Date & ".xlsx").Worksheets("Data1).Range("A1")
Snad jsem to popsal alespoň trochu srozumitelně, díky
(13.5.2016 17:32)#031516
Sub VyberDataRVV()
Dim kde As Range
Dim list As Worksheet
Dim sesit As Workbook
On Error Resume Next
Application.DisplayAlerts = False
'Stopky
'Definice proměnných
Dim zacatek As Double
Dim trvani As Double
Dim x As Long
Dim y As Single
'Zaznamenání času začátku
zacatek = Timer
'Samotný kód makra
For x = 1 To 100000000
y = y + x * y * Rnd - Rnd * y * x
Next x
'/stopky
Set sesit = Workbooks.Add
sesit.SaveAs Filename:="C:\Users\uzivatel\Desktop\Slozka\Data " & Date & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'uložení daného sešitu
Set list = Workbooks("Data " & Date & ".xlsx").Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'přídání listu na konec
list.Name = "DataRVV"
list.Tab.Color = RGB(255, 255, 200)
Set kde = Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("A1")
With kde
.Offset(0, 0) = "Mat"
.Offset(0, 1) = "Čj"
.Offset(0, 2) = "Bio"
.Offset(0, 3) = "Chem"
.Offset(0, 4) = "Tv"
.Offset(0, 5) = "Zem"
End With
Application.ScreenUpdating = False
Workbooks("makro.xlsm").Worksheets("Start").Activate
Workbooks("makro.xlsm").Worksheets("Start").Range("C2:C28").Select
Selection.FormulaArray = _
"=VALUE(INDIRECT(""'[""&M2&"".xlsx]""&N3&""'!""&P2))"
Workbooks("makro.xlsm").Worksheets("Start").Range("D2:D28").Select
Selection.FormulaArray = _
"=VALUE(INDIRECT(""'[""&M2&"".xlsx]""&N3&""'!""&P3))"
Workbooks("makro.xlsm").Worksheets("Start").Range("F2:F28").Select
Selection.FormulaArray = _
"=VALUE(INDIRECT(""'[""&M2&"".xlsx]""&N3&""'!""&P4))"
Application.Workbooks.Open ("C:\Users\uzivatel\Desktop\Slozka\Zdroj\Zdroj.xlsx") 'Zdroj dat
Workbooks("Zdroj.xlsx").Worksheets("Data").Range("A40:B65").Copy
Workbooks("makro.xlsm").Worksheets("Start").Range("A2").PasteSpecial Paste:=xlPasteValues
Application.Calculate
Workbooks("Zdroj.xlsx").Close
Application.ScreenUpdating = True
Workbooks("makro.xlsm").Worksheets("Start").Range("A2:F28").Copy
Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("A2").PasteSpecial Paste:=xlPasteValues
Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("E2").Formula = "=D2-C2"
Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("E2:E28").FillDown
Workbooks("makro.xlsm").Worksheets("Start").Range("A1:F38").Clear
list.Calculate
'stopky
'Porovnání začátku a konce makra
trvani = Timer - zacatek
'Zobrazení výsledku
list.Range("H2").Value = "Doba trvání makra: " & trvani
sesit.Worksheets("List1").Delete
sesit.Worksheets("List2").Delete
sesit.Worksheets("List3").Delete
sesit.Save
sesit.Close
Application.DisplayAlerts = True
End Subcitovat
Dim kde As Range
Dim list As Worksheet
Dim sesit As Workbook
On Error Resume Next
Application.DisplayAlerts = False
'Stopky
'Definice proměnných
Dim zacatek As Double
Dim trvani As Double
Dim x As Long
Dim y As Single
'Zaznamenání času začátku
zacatek = Timer
'Samotný kód makra
For x = 1 To 100000000
y = y + x * y * Rnd - Rnd * y * x
Next x
'/stopky
Set sesit = Workbooks.Add
sesit.SaveAs Filename:="C:\Users\uzivatel\Desktop\Slozka\Data " & Date & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'uložení daného sešitu
Set list = Workbooks("Data " & Date & ".xlsx").Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'přídání listu na konec
list.Name = "DataRVV"
list.Tab.Color = RGB(255, 255, 200)
Set kde = Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("A1")
With kde
.Offset(0, 0) = "Mat"
.Offset(0, 1) = "Čj"
.Offset(0, 2) = "Bio"
.Offset(0, 3) = "Chem"
.Offset(0, 4) = "Tv"
.Offset(0, 5) = "Zem"
End With
Application.ScreenUpdating = False
Workbooks("makro.xlsm").Worksheets("Start").Activate
Workbooks("makro.xlsm").Worksheets("Start").Range("C2:C28").Select
Selection.FormulaArray = _
"=VALUE(INDIRECT(""'[""&M2&"".xlsx]""&N3&""'!""&P2))"
Workbooks("makro.xlsm").Worksheets("Start").Range("D2:D28").Select
Selection.FormulaArray = _
"=VALUE(INDIRECT(""'[""&M2&"".xlsx]""&N3&""'!""&P3))"
Workbooks("makro.xlsm").Worksheets("Start").Range("F2:F28").Select
Selection.FormulaArray = _
"=VALUE(INDIRECT(""'[""&M2&"".xlsx]""&N3&""'!""&P4))"
Application.Workbooks.Open ("C:\Users\uzivatel\Desktop\Slozka\Zdroj\Zdroj.xlsx") 'Zdroj dat
Workbooks("Zdroj.xlsx").Worksheets("Data").Range("A40:B65").Copy
Workbooks("makro.xlsm").Worksheets("Start").Range("A2").PasteSpecial Paste:=xlPasteValues
Application.Calculate
Workbooks("Zdroj.xlsx").Close
Application.ScreenUpdating = True
Workbooks("makro.xlsm").Worksheets("Start").Range("A2:F28").Copy
Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("A2").PasteSpecial Paste:=xlPasteValues
Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("E2").Formula = "=D2-C2"
Workbooks("Data " & Date & ".xlsx").Worksheets("DataRVV").Range("E2:E28").FillDown
Workbooks("makro.xlsm").Worksheets("Start").Range("A1:F38").Clear
list.Calculate
'stopky
'Porovnání začátku a konce makra
trvani = Timer - zacatek
'Zobrazení výsledku
list.Range("H2").Value = "Doba trvání makra: " & trvani
sesit.Worksheets("List1").Delete
sesit.Worksheets("List2").Delete
sesit.Worksheets("List3").Delete
sesit.Save
sesit.Close
Application.DisplayAlerts = True
End Subcitovat
Zdravím,
Omlouvám se u kodu mi vypadl text, tady je...
děkuji za tip na formulář, je to opravdu mnohem elegantnější řešení.
V případě druhého problému se pokusím vyjádřit přesněji.
Mám zdrojový soubor a z několika jeho listů potřebuji vykopírovat určitá data a ty vložit do nového souboru a ty data rozdělit opět na více listů.
Potřeboval bych na začátek makra dát podmínku ve smyslu: Vyber daná data ze zdroje a vytvoř nový sešit, list a dej tam daná data. Pokud je již sešit vytvořen (protože se spustil už jiný výběrový dotaz), přidej k danému sešitu pouze list a tam ty dej.
Makro jako takové mi funguje, sice věřím, že to je velmi krkolomně napsané, ale funguje. Aktuálně bych potřeboval jen vyřešit výše popsaný problém.
Děkuji za pomoccitovat
Omlouvám se u kodu mi vypadl text, tady je...
děkuji za tip na formulář, je to opravdu mnohem elegantnější řešení.
V případě druhého problému se pokusím vyjádřit přesněji.
Mám zdrojový soubor a z několika jeho listů potřebuji vykopírovat určitá data a ty vložit do nového souboru a ty data rozdělit opět na více listů.
Potřeboval bych na začátek makra dát podmínku ve smyslu: Vyber daná data ze zdroje a vytvoř nový sešit, list a dej tam daná data. Pokud je již sešit vytvořen (protože se spustil už jiný výběrový dotaz), přidej k danému sešitu pouze list a tam ty dej.
Makro jako takové mi funguje, sice věřím, že to je velmi krkolomně napsané, ale funguje. Aktuálně bych potřeboval jen vyřešit výše popsaný problém.
Děkuji za pomoccitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články