Příspěvky uživatele

XLSM musí byť zabalené do ZIP, a nesmie prekročiť 256 KB. Ak to nestačí, použite GoogleDrive a pod...

Príklad. Ale s veľa "čo keď".
Napr. čo keď súbor neexistuje ? Vytvoriť z nejakej šablóny ?
Čo keď meno nieje na zozname mien, ktorých sa týka kopírovanie ?
Čo keď je už daný riadok skopírovaný ? Zmazať ho ? Nejako ho označiť ?
Čo keď je riadok nezmazaný, ale označený, tak ho ignorovať, aj keď v ňom prišlo k zmene ?
Čo ak je súbor s menom otvorení, zatvoriť ho ? (teraz ho zatvorí, ak sa o také meno jedná)
...

Dáva Vám ten popis zmysel ? Mne nie. Takže:

-Máte viac ako 50 mien, ale kopírovať riadky sa majú len ak sa objaví meno z úzkej skupiny 50 mien ? Ak sa objaví ine meno, tak nie ?

-Kopírovať sa musia bunky (formáty, orámovanie, farba a pod.) , alebo hodnoty (do prednaformátovaných stĺpcov) ?

-Majú stĺpce v liste "Hlavní" hlavičky ? Aj v "Hotovo" ?

EDIT 13:06 :
Príklad toho, čo z neúplného popisu vyplýva.

Pr.
Sub Test()
Dim time As Date
Dim limit_A As Date
Dim limit_B As Date

time = Now()

limit_A = Int(time) + TimeValue("02:50")
limit_B = Int(time) + TimeValue("01:30")

ActivePresentation.Slides(1).Shapes("1").TextFrame.TextRange.Text = IIf(limit_A > time And time > limit_B, "Ano", "Ne")

End Sub
Pohybujete sa na prelome dní, treba počítať aj s dátumom.

Vložte nejakú prílohu s príkladom. Či sú v zošitoch len požadované dátové listy alebo aj iné, ktoré sa zahŕňať nemajú. Či sa menia názvy listov. Či pribúdajú listy v zošitoch. Zošity už pribúdajú, to ste spomenul. Sú dáta vo všetkých listoch na rovnakých miestach? Rovnako široké aj vysoké? Jedná sa o celé stĺpce, či len pár nesúvislých buniek/oblastí? O koľko dát asi celkom ide (1000 riadkov x 10 stĺpcov, 100000 riadkov x 20 stĺpcov ... ) ? ...

Ja by som to dal takto nejako, kde si možno zvoliť jasné 2 parametre.
Public Function QRX(CielBunka As Range, Hodnota As String)
VmazStaryQR CielBunka
If Hodnota <> "" Then
With CielBunka.Parent.Pictures.Insert("http://chart.apis.google.com/chart?chs=150x150&cht=qr&chl=" & Replace(Hodnota, " ", "%20") & "&choe=ISO-8859-1/chart.png")
.Name = "QR_" & CielBunka.Address(0, 0)
.Left = CielBunka.Left
.Top = CielBunka.Top
End With
End If
QRX = "OK"
End Function

Public Sub VmazStaryQR(CielBunka As Range)
On Error Resume Next
CielBunka.Parent.Shapes("QR_" & CielBunka.Address(0, 0)).Delete
End Sub

1 Cieľová bunka - kde sa má zobraziť QR
2 Zdrojová hodnota - je jedno či vzorec či odkaz na inú bunku

Veď je to banálne jednoduché. No a ak by sa mal QR vkladať do bunky z ktorej je QRX funkcia volaná, tak by sa to vyriešilo drobučkou úpravou kódu, keď by sa použil kvôli circular reference, odkaz na referenčnú bunku napr. vpravo od nej, a cez Offset by sa získala správna adresa.

Keby dal prílohu má to dávno hotové.

Šmarjá ... Ondrej, dajte sem prílohu. Nieje jasné či chcete aby sa QR zobrazil v bunke v ktorej je vzorec, alebo vzorec je inde, a QR zase inde. Ani som nepobral, či chcete viac riadkov a pre každý vlastný QR, a pod, alebo či je vždy len jeden vzorec s QRX funkciou a jeden jediný QR kód... Normálne sa zaregistrujte, urobte prílohu XLSM, zabalte ju do ZIP, nahrajte. Dostanete odpoveď.

OT: Tak som Vám do tej témy šupol podstatne jednoduchšiu verziu tých vzorcov. Tieto už dáte

Podstatne kratšie vzorce (tie červené vpravo).

EDIT:
Prípadne, ak by bolo zrejmé, že sa každá metóda vyskytuje v celom stĺpci iba raz (čo nemusí tak, pretože napr. služba "konzultace" môže byť napr. aj v estetike aj v liečení...), tak stačí ten prvý maticový, a ostatné dva iba cez VLOOKUP/SVYHLEDAT:
=IF(E6="";"";VLOOKUP(E6;Služby!$C$5:$F$28;2;FALSE))
=KDYŽ(E6="";"";SVYHLEDAT(E6;Služby!$C$5:$F$28;2;NEPRAVDA))
a
=IF(E6="";"";VLOOKUP(E6;Služby!$C$5:$F$28;4;FALSE))
=KDYŽ(E6="";"";SVYHLEDAT(E6;Služby!$C$5:$F$28;4;NEPRAVDA))

Lebo na to idete zle. Zmente deklaráciu funkcie zo stringového parametru na Range:
Public Function QRX(T As Range)
potom TEXT urobte napr. (záleží aké údaje bunka obsahuje, dá sa použiť FORMAT(), alebo nejaké zaokrúhlenie a pod...):
TEXT = CStr(T)
a potom všade slovo ActiveCell nahraďte za T. Teda napr.:
T.Left
V tom prvom príspevku od Jeza.m je to minimálne na 5 miestach.

A potom to funguje tak, že QR vloží tam, aký parameter je vo funkcii.

Z brucha a bez vyskúšania:
Sub DeleteCon()
Dim i As Integer
With ThisWorkbook
For i = .Connections.Count To 1 Step -1
.Connections(i).Delete
Next i
For i = .Queries.Count To 1 Step -1
.Queries(i).Delete
Next i
End With
End Sub

A ešte pozrite Podmienené formátovanie. Tak sa tiež niekedy skrývajú. Prípadne rozbaľovacie zoznamy.

@SACHIVA: Priložte prílohu s príkladom toho čo máte, aj toho ako to má vyzerať.

Hneď prvý odkaz na Google:
Sub FolderSize()
Dim fso As Object, fsoFolder As Object
Const strFolderName As String = "d:\adresár\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFolder = fso.GetFolder(strFolderName)

MsgBox fsoFolder.Size & " bytes"

Set fsoFolder = Nothing
Set fso = Nothing

End Sub

EDIT:
Tu som Vám spravil príklad načítania veľkosti všetkých podadresárov.

S tým sa nedá nesúhlasiť.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range

Set Zmena = Intersect(Range("A1:K20"), Target)
If Not Zmena Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next

With Zmena
.Borders(xlDiagonalUp).LineStyle = xlNone
.SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalUp).LineStyle = xlContinuous
End With

Set Zmena = Nothing
Application.ScreenUpdating = True
End If
End Sub

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje