Moc opět děkuju Elnino!citovat
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: Barevné zvýraznění aktivního tlačítka pro makro
MS Excel
Téma: Barevné zvýraznění aktivního tlačítka pro makro 
Zaslal/a PavelJanec 16.11.2022 9:04
Zdravím, potřeboval bych prosím poradit, jestli lze nějak barevně odlišit právě použité makro, spuštěné ovládacím prvkem (klasické tlačítko). Mám jich v listu několik, ale potřebuju vidět, které je právě aktivní. Děkuji za radu.
Ještě bych se Vás zeptal Elnino. Když v exportovaném listu mám ovládací tlačítka, vyexportuje se mi to i s nimi. Jde nějak do toho kódu zakomponovat, aby tomu tak nebylo a zůstal čistý excelový soubor? Děkujicitovat
Žiadny export sme predsa neriešili. Každopádne buď vymažte menný zoznam (ak ho viete):
ActiveWorkbook.Worksheets(1).Buttons(Split(NAZVY & ",btnReset", ",")).Delete
alebo vymažte všetky nájdené tlačítka na liste (ak neviete ich názvy a počet):
Dim btn As Button
For Each btn In ActiveWorkbook.Worksheets(1).Buttons
btn.Delete
Next btncitovat
ActiveWorkbook.Worksheets(1).Buttons(Split(NAZVY & ",btnReset", ",")).Delete
alebo vymažte všetky nájdené tlačítka na liste (ak neviete ich názvy a počet):
Dim btn As Button
For Each btn In ActiveWorkbook.Worksheets(1).Buttons
btn.Delete
Next btncitovat
Ta druhá varianta funguje, nicméně dělá mi to pak chybu při použití jiného tlačítka. K té první variantě nevím, co myslíte tím jmenným seznamem. Myslíte názvy tlačítek? Viz "najít a vybrat / poddokno výběru? Tam mám Button 1 a Button 2, ale nevím, jak to zakomponovat. Jinak řešili jsme to a funguje to bez problémů, tohle mám od Vás.
Sub akce_tydne_export_new_final()
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\NÁZEV.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Sub
Tento kód mi to vyexportuje perfektně, akorát, že tam zůstanou tlačítka.citovat
Sub akce_tydne_export_new_final()
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\NÁZEV.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Sub
Tento kód mi to vyexportuje perfektně, akorát, že tam zůstanou tlačítka.citovat
Takže to nie je táto téma. Mali ste dať otázku do danej témy, alebo pridať odkaz na danú tému alebo prílohu. Automaticky som predpokladal nasledovné:
-Pod exportom si v drvivej väčšine predstavujem export dát a iba dát. Teda bez tlačítok, bez makier. Teda mažem všetky tlačítka. Preto
Dim btn As Button
For Each btn In ActiveWorkbook.Worksheets(1).Buttons
btn.Delete
Next btn
-Predpokladám, že hovoríte o tejto téme, a teda predpokladám tlačítka spomínané v tejto téme. Preto
ActiveWorkbook.Worksheets(1).Buttons(Split(NAZVY & ",btnReset", ",")).Delete
-Export listu sa robí väčšinou (záleží prípad od prípadu) pomocou .Copy listu, a následnom mazaní ovládacích tlačítok z aktívneho novovytvoreného zošitu. Preto
ActiveWorkbook...
Vy ale obchádzate všetky predpoklady, neupozorníte na inú tému, neodkážete na prílohu, nespomeniete názvy tlačítok.
Takže.
1. Ak poznáte názvy tlačítok (Nájsť a vybrať - Tabla výberu)
NejakýZošit.NejakýList.Buttons(Array("Button 1", "Button 2")).Delete
2. Ak nepoznáte názvy tlačítok, alebo neviete ich počet
Dim btn As Button
For Each btn In NejakýZošit.NejakýList.Buttons
If btn.name<>"toto tlačítko nemazať" Then btn.Delete
Next btn
Čo znamená ?
citovat
-Pod exportom si v drvivej väčšine predstavujem export dát a iba dát. Teda bez tlačítok, bez makier. Teda mažem všetky tlačítka. Preto
Dim btn As Button
For Each btn In ActiveWorkbook.Worksheets(1).Buttons
btn.Delete
Next btn
-Predpokladám, že hovoríte o tejto téme, a teda predpokladám tlačítka spomínané v tejto téme. Preto
ActiveWorkbook.Worksheets(1).Buttons(Split(NAZVY & ",btnReset", ",")).Delete
-Export listu sa robí väčšinou (záleží prípad od prípadu) pomocou .Copy listu, a následnom mazaní ovládacích tlačítok z aktívneho novovytvoreného zošitu. Preto
ActiveWorkbook...
Vy ale obchádzate všetky predpoklady, neupozorníte na inú tému, neodkážete na prílohu, nespomeniete názvy tlačítok.
Takže.
1. Ak poznáte názvy tlačítok (Nájsť a vybrať - Tabla výberu)
NejakýZošit.NejakýList.Buttons(Array("Button 1", "Button 2")).Delete
2. Ak nepoznáte názvy tlačítok, alebo neviete ich počet
Dim btn As Button
For Each btn In NejakýZošit.NejakýList.Buttons
If btn.name<>"toto tlačítko nemazať" Then btn.Delete
Next btn
Čo znamená ?
nicméně dělá mi to pak chybu při použití jiného tlačítka
Já Vám rozumím Elnino, ale kam to mám zakomponovat? Když používám tento kód?
------------------------------------------------------------------------------
Sub akce_tydne_export_new_final()
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\NÁZEV.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Sub
-----------------------------------------------------------------------
Když to udělám takto, nefunguje to.
Sub akce_tydne_export_new_final()
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
ActiveWorkbook.Worksheets(List 3).Buttons(Array("Button 1", "Button 2")).Delete
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\NÁZEV.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Sub
Tento kód mi to vyexportuje perfektně, akorát, že tam zůstanou tlačítka.citovat
------------------------------------------------------------------------------
Sub akce_tydne_export_new_final()
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\NÁZEV.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Sub
-----------------------------------------------------------------------
Když to udělám takto, nefunguje to.
Sub akce_tydne_export_new_final()
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
ActiveWorkbook.Worksheets(List 3).Buttons(Array("Button 1", "Button 2")).Delete
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\NÁZEV.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Sub
Tento kód mi to vyexportuje perfektně, akorát, že tam zůstanou tlačítka.citovat
Takže poznáte či nepoznáte počet a názvy všetkých tlačítok?citovat
Těch tlačítek je v tomto konkrétním listu (List 3) celkem 8, a jmenují se Button 1, Button 2 atd..Proto jsem Vám poslal ten poslední kód, kde jsem úmyslně zahrunul jen první dvě tlačítka, abych věděl, jestli to půjde, ale nejde. Tak jeětě jednou, tento kód používám pro export a jsem s ním spokojený, až na ty tlačítka, které mi sice při následném importu do shopu nevadí, ale byl bych raději, kdyby tam nabyly. Takže samotný kód je tento. A já ho potřebuju upravit, aby exportoval bez tlačítek.
--------------------------------------------------
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\IMP Produkty\import1.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End Withcitovat
--------------------------------------------------
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1).UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
R = .Parent.Cells(Rows.Count, "A").End(xlUp).Row
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\IMP Produkty\import1.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End Withcitovat
Sub Vytvor_import()
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1)
R = .Cells(.Rows.Count, "A").End(xlUp).Row
With .UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
.Buttons(Array("Button 1", "Button 2", "Button 3", "Button 4", "Button 5", "Button 6", "Button 7", "Button 8")).Delete
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\IMP Produkty\import1.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Subcitovat
ThisWorkbook.Worksheets("List 3").Copy
With ActiveWorkbook
With .Worksheets(1)
R = .Cells(.Rows.Count, "A").End(xlUp).Row
With .UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues
.Resize(.Rows.Count - R + 1).Offset(R, 0).EntireRow.Delete Shift:=xlUp
End With
.Buttons(Array("Button 1", "Button 2", "Button 3", "Button 4", "Button 5", "Button 6", "Button 7", "Button 8")).Delete
End With
Application.DisplayAlerts = False
.SaveAs "C:\Users\DELL i7\Desktop\IMP Produkty\import1.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
.Close False
End With
End Subcitovat
Děkuji Elnino, vyzkouším a dám vědět.citovat
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