< návrat zpět

MS Excel

Téma: VBA propojení ovládacích prvků rss

Zaslal/a Anonym 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

Zaslat odpověď >
elninoslov(13.5.2016 1:54)#031505
elninoslov
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: zip31505_pomoc-s-makrom.zip (35kB, staženo 19x)
citovat
Anonym(13.5.2016 17:32)#031516
avatar
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
Away(13.5.2016 21:39)#031517
avatar
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

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 0:34

Vynásobit hodnoty kurzem - Power Query

Alfan • 24.4. 16:32

Relativní cesta - zdroje Power Query

Alfan • 24.4. 15:44

Relativní cesta - zdroje Power Query

elninoslov • 24.4. 14:26

Jak odstraním duplicitní údaje

Mirek8 • 24.4. 12:13

Jak odstraním duplicitní údaje

elninoslov • 24.4. 8:57

Vyhledej

PavDD • 24.4. 8:56