Příspěvky uživatele

Zkoušel jsem a vážně to nejde ;-), Excel to bere tak, že to tam není...
Mno, možno máte na mysli niečo iné, ale pokiaľ je problém s vykreslením grafu na základe datových sérií, ktoré sú skryté, tak:
1.klik na graf pravým tlačítkom myšky
2.select data
3.v dialógovom okne klik na Hidden and Empty Cells
4.zatrhnúť možnosť Show data in hidden rows and columns

Jde vypnout níže uvedený kód při spuštění jiného makra?
Ahoj, nakoľko horeuvedený kód je udalostná procedúra,
tak niekam na začiatok toho druhého kódu, ktorý spôsobuje udalosť Worksheet_Change tým, že do daného listu niečo vpisuje, zadaj inštrukciu:Application.EnableEvents = Falsea pred jeho dobehnutím niekam na koniec pre zmenu Application.EnableEvents = True

Ako u x iných vecí, kedy sa v podstate jedná o triedenie či filtrovanie nejakého zoznamu, i v tomto prípade sa dá využiť MS Query..
Command text v danom prípade:

SELECT Bodů, Příjmení, Jméno, Značka
FROM `Data$`
ORDER BY Bodů DESC

njn, potrápil si ma trochu, ale nakoniec to predsa len k niečomu bolo

Problém je v tom, že z tlačítka voláš makro, ktoré si umiestnil do kódového okna listu, nie do modulu, ach jo

V takom prípade, pokiaľ sa odkazuješ na iné listy, musíš pri adresovaní používať tzv. full qualifying, t.j. uvádzanie názvov listov, na ktoré v kóde odkazuješ.
Nejaký dôvod, prečo je to tlačítko ActiveX objekt miesto normálneho command buttonu? No nič, nechám toho.

Vyriešiš nasledovne.
Tlačítku priradíš kód:
Private Sub CommandButton3_Click()
Call SkopirujNeprazdneHodnoty
End Sub
A kód SkopirujNeprazdneHodnoty umiestniš do modulu, nie do kódového okna Listu!

Tak to neviem...
Stiahol som si tvoj súbor, vložil doňho modul, nakopíroval kód a žiadny error to nehádže. Skopíruje bunky B24-B34 z listu Nabídka_im do listu Nabídka

Mno, síce zmršené, páč sa mi nechce to tvoriť úplne od začiatku, ale snáď funkčné (som zvedavý, za čo môžem tentokrát):Sub SkopirujNeprazdneHodnoty()
Dim FirstCell As Range, LastCell As Range, SourceRange As Range, SourceRangeToLeave As Range
Dim cell As Range, SourceRangeToCopy As Range
With Sheets("Nabídka_im")
Set FirstCell = .[B24]
If IsEmpty(FirstCell) Then Set FirstCell = FirstCell.End(xlDown)
If IsEmpty(FirstCell) Then
Set FirstCell = Nothing
Exit Sub
End If
Set LastCell = .[B124]
If IsEmpty(LastCell) Then Set LastCell = LastCell.End(xlUp)
Set SourceRange = Range(FirstCell, LastCell)
On Error GoTo ErrHandler
Set SourceRangeToLeave = SourceRange.SpecialCells(xlCellTypeBlanks)
Set SourceRangeToCopy = Nothing
For Each cell In SourceRange.Cells
If Intersect(cell, SourceRangeToLeave) Is Nothing Then
If Len(cell) > 0 Then
If SourceRangeToCopy Is Nothing Then
Set SourceRangeToCopy = cell
Else: Set SourceRangeToCopy = Union(cell, SourceRangeToCopy)
End If
End If
End If
Next cell
End With
Label1:
Set FirstCell = Nothing
Set LastCell = Nothing
Set SourceRange = Nothing
Set SourceRangeToLeave = Nothing
Set cell = Nothing
If Not SourceRangeToCopy Is Nothing Then
SourceRangeToCopy.Copy
Sheets("Nabídka").[B24].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Set SourceRangeToCopy = Nothing

ErrHandler:
If Err.Number = 1004 Then
Set SourceRangeToCopy = Nothing
For Each cell In SourceRange.Cells
If Len(cell) > 0 Then
If SourceRangeToCopy Is Nothing Then
Set SourceRangeToCopy = cell
Else: Set SourceRangeToCopy = Union(cell, SourceRangeToCopy)
End If
End If
Next cell
Resume Label1
End If
End Sub

V mojom kóde to určuje LastCell, ale tebe to je na draka, páč ja som vychádzal len zo zadania, ktoré si dal a kde som si pár vecí musel domyslieť - špatne. Písal si totiž, že chceš kopírovať neprázdne bunky z oblasti B24 až dolu, teraz píšeš po B124, ale neprázdne bunky sú i B125-B129, B131 a B137, ako hovorím, líná huba, holé neštěstí

miestoSet LastCell = .Cells(.Rows.Count, "B")by za norálnych okolností stačilo napísať:Set LastCell = .[B124]bohužiaľ, zostáva tu problém, že si zmieňoval neprázdne bunky a neuvedomil si, že bunka s hodnotou "" nie je neprázdnou bunkou..

No, a okrem toho sa mi zdá, že do toho listu Nabídka by si potreboval skopírovať z listu Nabídka_im i hodnoty zo stĺpcov C-L a to teda z toho tvojho pôvodného kódu úplne zrejmé tiež nebolo. Takže, ako hovorím, z mojej strane minimálne hodina v podstate úplne zbytočnej práce... Aspoň som si ošahal error handling, bohužiaľ pre teba, iba na príklade, ktorý som si pre potrebu kódu vytvoril sám, páč vzor, v ktorom si to potreboval poriešiť, si nedal a zadanie bolo nepresné...

Martine, je mi ľúto, ale opravovať to nebudem, skús na to prísť sám, keď nie si schopný dať vzor hneď na začiatku

Len dve poznámky, na liste Nabídka_im:
1. máš na riadku 137 zlúčenú bunku, tú si láskavo zruš, alebo na to upozorni, že bez toho nemôžeš existovať, keď tu píšeš žiadosť o pomoc.
2. v stĺpci B máš okrem prázdnych buniek i bunky obsahujúce vzorce, hodnota je síce "", ale to nie je prázdna bunka!

Takže si to dorob, alebo sa nauč vkladať prílohu - hneď. Nerád robím zbytočnú prácu, ako v tomto prípade

K tým formátom v textboxoch - nejako takto, je to len návod, budeš si musieť dotvoriť:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.TextBox1 = Format(CDbl(Me.TextBox1.Value), "#,##0.00")
Me.TextBox1.Font.Bold = True
End Sub

Jirko: to asi nebude ono, zkusil jsem to, ale pak mi to hází chybu makra.
Ale je to ono, nastav ShowModal na FALSE u všetkých formulárov (máš ich 7) a uvidíš.

Tie formáty neviem, na to by som sa musel pozrieť a priznám sa, moc sa mi nechce, to asi nevyriešim za pár minút..

Ten prvý problém asi bude treba ošetriť nejakým kódom.

Ten druhý (preklikávanie atď.): Pre formulár musíš nastaviť vlastnosť ShowModal na FALSE

No, čítam špatne, takže ten predošlý pokus nie je zrejme to, čo potrebuješ, tu je oprava (dokonca som použil prvýkrát error handler

):Sub SkopirujNeprazdneHodnoty()
Dim FirstCell As Range, LastCell As Range, SourceRange As Range, SourceRangeToLeave As Range
Dim cell As Range, SourceRangeToCopy As Range
With Sheets("Nabídka_im")
Set FirstCell = .[B24]
If IsEmpty(FirstCell) Then Set FirstCell = FirstCell.End(xlDown)
If IsEmpty(FirstCell) Then
Set FirstCell = Nothing
Exit Sub
End If
Set LastCell = .Cells(.Rows.Count, "B")
If IsEmpty(LastCell) Then Set LastCell = LastCell.End(xlUp)
Set SourceRange = Range(FirstCell, LastCell)
If SourceRange.Cells.Count > 2 Then
On Error GoTo ErrHandler
Set SourceRangeToLeave = SourceRange.SpecialCells(xlCellTypeBlanks)
Set SourceRangeToCopy = Nothing
For Each cell In SourceRange.Cells
If Intersect(cell, SourceRangeToLeave) Is Nothing Then
If SourceRangeToCopy Is Nothing Then
Set SourceRangeToCopy = cell
Else: Set SourceRangeToCopy = Union(cell, SourceRangeToCopy)
End If
End If
Next cell
Else: Set SourceRangeToCopy = SourceRange
End If
End With

Label1:
Set FirstCell = Nothing
Set LastCell = Nothing
Set SourceRange = Nothing
Set SourceRangeToLeave = Nothing
Set cell = Nothing

SourceRangeToCopy.Copy
Sheets("Nabídka").[B24].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set SourceRangeToCopy = Nothing

ErrHandler:
If Err.Number = 1004 Then
Set SourceRangeToCopy = SourceRange
Resume Label1
End If
End Sub

Je mi záhadou, že pri tom, čo tvoríš (tú aplikáciu pre manželku) a vo svetle toho, čo máš hotové, nie si schopný si poradiť s touto trivialitou

.

Za predpokladu, že [B24] v zdrojovej oblasti nie je prázdne, tak takto:Sub pom()
Dim FirstCell As Range, LastCell As Range, SourceRange As Range
With Sheets("Nabídka_im")
Set FirstCell = .[B24]
Set LastCell = FirstCell.End(xlDown)
If Not IsEmpty(LastCell) Then
Set SourceRange = Range(FirstCell, LastCell)
Else: Set SourceRange = FirstCell
End If
End With
SourceRange.Copy
Sheets("Nabídka").[B24].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set FirstCell = Nothing
Set LastCell = Nothing
Set SourceRange = Nothing
End Sub

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje