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

Příspěvky uživatele

prvky formulare nepouzivam, ale zkuste
ActiveSheet.Shapes("Scroll Bar 1").OLEFormat.Object.Enabled = False

sam jsem zvedavy

@marjankaj

target může mít i více oblastí ;)

Private Sub Worksheet_Change(ByVal Target As Range)
Const VALIDATION_FORMULA As String = "=SEZNAM"

Dim bEvents As Boolean
bEvents = Application.EnableEvents
Application.EnableEvents = False

Dim sValidationFormula As String

Dim rArea As Range, rCell As Range
For Each rArea In Target.Areas
For Each rCell In rArea.Cells
If Not IsEmpty(rCell) Then
sValidationFormula = vbNullString
On Error Resume Next
sValidationFormula = rCell.Validation.Formula1
On Error GoTo 0
If sValidationFormula = VALIDATION_FORMULA Then
rCell.Value = UCase(rCell.Value)
End If
End If
Next rCell
Next rArea

Application.EnableEvents = bEvents
End Sub

@Opičák

tady bych do toho nešel.
Co když bude chtít změnit více hodnot najednou?

Sub subDeleteRows()
Dim rForm As Range
Set rForm = Range("E2:H22")

Dim lCalc As Long
lCalc = Application.Calculation
Application.Calculation = False
Dim bScreen As Boolean
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False

With Range("E26").Resize(rForm.Rows.Count, rForm.Columns.Count)
.Value = rForm.Value
Dim I As Integer
For I = .Rows.Count To 1 Step -1
If IsEmpty(.Rows(I).Cells(4)) Or .Rows(I).Cells(4).Value = 0 Then
If Not IsEmpty(.Rows(I).Cells(1)) Then
.Rows(I).Cells(1).Offset(1, 0).Value = .Rows(I).Cells(1).Value
End If
.Rows(I).Delete Shift:=xlUp
End If
Next I
End With 'Range("26").Resize(rForm.Rows.Count, rForm.Columns.Count)

Application.ScreenUpdating = True
Application.Calculation = lCalc

Set rForm = Nothing
End Sub

V KT přepište ten text (blank) - buď 1 mezera, nebo to co místo toho chcete
Změní se všechny

Pokud by se to mělo řešit VBA, nechal bych se inspirovat tady
http://excelplus.net/news.php?readmore=20

4) Walkenbachův postup aneb ExecuteExcel4Macro

arg = "'" & Cesta & "[" & Soubor & "]" & List & "'!" & Range(Oblast).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)

Tyto 2 řádky by měly splnit, co se od nich čeká a asi bych to vrhl do vlastní funkce.

Jen poznámka: Předpokládáte, že všichni mají 7-zip?. Už rar je pro mě nepochopitelný, když je jasné, že všichni mají zip ve svém OS (ne všichni mají adminpráva k PC).

Řešilo se zde
http://excelplus.net/forum/viewthread.php?thread_id=413

Jestli existuje nějaké řešení vzorcem nevím, ale myslím, že bude třeba VBA. Tedy pokud někdo jiný nezná řešení.

Přemýšlel jsem nad verzí aby se po vytvoření kopie odstranili nepotřebné listy, ale bude jich cca 30 a nevím zda je to správná cesta je všechny odstraňovat a zachovat jen jeden

A co naopak - vytvořít kopii toho listu a nemazat nic

Dim wNewWorkbook As Workbook
Set wNewWorkbook = Workbooks.Add

ThisWorkbook.Worksheets("ListKExportu").Copy Before:=wNewWorkbook.Sheets(1)
Dim sh As Worksheet
For Each sh In wNewWorkbook.Sheets
Application.DisplayAlerts = False
If Not sh.Name = "ListKExportu" Then sh.Delete
Application.DisplayAlerts = True
Next sh
Set sh = Nothing

'kód (nějaké uložení wNewWorkbook.SaveAs)
Set wNewWorkbook = Nothing
nebo možná jednodušší - nemám otestovanou spolehlivost, ale nevidím důvod k problémům
ThisWorkbook.Sheets("ListKExportu").Copy
Dim wNewWorkbook As Workbook
Set wNewWorkbook = ActiveWorkbook
'kód (nějaké uložení wNewWorkbook.SaveAs)
Set wNewWorkbook = Nothing

datum přiřadíte
c_Listku = format(Worksheets("Návrh_lístku").Cells(1, 21).value,"ddmmyyyy")

Podle mne si zbytečně komlikujete život
Nestačilo by?

Private Sub CommandButton1_Click()
With Range("B2:B31")
.Formula = "=RANDBETWEEN(1,100)"
.Value = .Value
End With 'Range("B2:B31")
End Sub

Nastavil bych to pouze na oblast, které se týká to ověření dat.
Třeba nějak takhle:

Private Sub Worksheet_Change(ByVal Target As Range)
Const VALIDATION_FORMULA As String = "=SEZNAM"

Dim sValidationFormula As String
sValidationFormula = vbNullString

On Error Resume Next
sValidationFormula = Target.Validation.Formula1
On Error GoTo 0
If sValidationFormula = VALIDATION_FORMULA Then
Dim bEvents As Boolean
bEvents = Application.EnableEvents
Application.EnableEvents = False

Target.Value = UCase(Target.Value)

Application.EnableEvents = bEvents
End If
End Sub

Vzorečkama a máte to i seřazené podle abecedy ;)

Je tam náhodné číslo, takže po F9 se přepočítá.

Snažil jsem se to něják vyřešit bez použití makra

To jsou mi věci.
Kolik je těch listů?
Zkusil jste?
Na každém list si vytvořte pojmenovaný vzorec, který bude obsahovat
=KDYŽ(B45="něco";"Název listu";"")

do buňky
=NázevZListu1&","&NázevZListu2&","&NázevZListu3

Pro ten vzorek

Private Sub UserForm_Initialize()
With ListBox1
.RowSource = "List3!A1:C3"
.ColumnCount = 3
End With 'ListBox1
End Sub

Zatím asi dík za rady..

Zatím asi není zač ;)

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse