Příspěvky uživatele
< návrat zpět
Keď už som to spytlíkoval, tak to sem tiež dám :)Sub OtvorSuboryVadresari()
Dim fldr As FileDialog, sItem As String, strF As String, wb As Workbook
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Vyber adresar"
.AllowMultiSelect = False
' .InitialFileName = strPath
If .Show <> -1 Then
MsgBox "Nezvolil si adresar"
GoTo Label_1
Else: sItem = .SelectedItems(1)
End If
End With
strF = Dir(sItem & "\A*.xl*")
Do While strF <> vbNullString
Set wb = Workbooks.Open(sItem & "\" & strF)
strF = Dir()
Loop
Set wb = Nothing
Label_1:
Set fldr = Nothing
End Sub
Bez prílohy je to trochu veštenie z krištálovej gule...
Zaregistruj sa a vlož sem zazipovaný XL súbor. Z popisu nie je úplne zrejmé, čo myslíš zakrížkovaním, akým spôsobom si získal hodnoty na riadku součet pro školu, ani čo máš vlastne v jednotlivých stĺpcoch.
Skús svoje zadanie čítať a pochopiť bez toho, že by si vedel, čo potrebuješ dosiahnuť a posúď sám, či je možné to pochopiť bez toho, aby sa tomu človek venoval zbytočne dlho....
Bude sa jednať o triviálnu úlohu, ale i tak by to chcelo vzorový súbor.
V podstate minimálne upravené z on-line nápovedy k statusbar:Sub test()
Dim oldStatusBar As String
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Please be patient..."
'Workbooks.Open Filename:="LARGE.XLS"
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
End Sub
Zatiaľ sa to dá, resp. ja to robím takým "dosť" pracným spôsobom: Skončím prácu v zošite1, modul z toho zošita skopírujem do zošita2 (kde už modul s rovnakým názvom je), vymažem starý modul zo zošitu2, a aktualizovaný modul premenujem na stály názov.
No, naozaj prácnym 
Jednoduchšie:
1. klikni do okna modulu v zošite 1
2. ctrl+a
3. ctrl+c
4. klikni do okna modulu v zošite 2
5. ctrl+a
6. ctrl+v
odpadá odstraňovanie a premenovávanie modulov
K povoleniu filtru: skúsil som makro v module1. Pre názornosť kopírujem jeho pôvodný tvar a modifikáciu, ktorá umožňuje filtrovanie.Sub Makro1()
ActiveSheet.Unprotect "Ooz2014JK"
Selection.Rows.AutoFit
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingRows:=True, AllowFiltering:= _
True
ActiveSheet.Protect "Ooz2014JK"
End Sub
Sub MakroModifiedByAL()
With ActiveSheet
.Unprotect "Ooz2014JK"
Selection.Rows.AutoFit
.Protect Password:="Ooz2014JK", AllowFiltering:=True
.EnableSelection = xlUnlockedCells
End With
End Sub
@Bartus:
1. Jestli je vubec excel na toto vhodny, nebo jit radeji do nejakeho databazoveho programu.
2. tak to je pro mne uplna spanelska vesnice
Pmn ten druhý statement dosť obmedzuje možnosti prvého 
Každopádne, skutočné databázové riešenie je určite vhodnejšie, než sa pokúšať matlať to v exceli a napr. pre Access by to asi žiadny big deal nebol...
ikdyž mé původní přání bylo u navýšení zobrazit červenou šipku vzhůru a u poklesu poklesu zelenou směrem dolů
toto cez podmienené formátovanie zrejme nepôjde ale dá sa vlastným formátom
@Paloo netusim ako funguje zdileny dokument
často funguje s problémami
Kein problem Sub AddToAutoCorrectList()
'makro zapise do zoznamu automatickych oprav hodnoty zo stlpcov A a B aktivneho listu
'stlpec A obsahuje stare hodnoty
'stlpec B obsahuje hodnoty k nahradeniu tzn.:
'pokial napiseme Alabama a chceme automatickou opravou zmenit na Al, Alabama bude v stlpci A a Al v stlpci B
'hodnoty zacinaju na riadku 1, bez zahlavia stlpcov
Dim cell As Range
With ActiveSheet
Set cell = .[A1]
Do While cell <> ""
Application.AutoCorrect.AddReplacement cell, cell.Offset(0, 1)
Set cell = cell.Offset(1, 0)
Loop
Set cell = Nothing
End With
End Sub
Už to mám, som blbý , bolo potrebné nahradiť kolekciu Shapes za Scrollbars, takto: With Sheet15
' With .Shapes("OverviewScrollBarVertical")
With .ScrollBars("OverviewScrollBarVertical")
Select Case Sheet16.Range("OverviewTypeOfData")
Case 1, 4, 5, 6
Select Case [OverviewWayOfView]
Case 1, 2: .Left = [Q17].Left + 5
Case Else: .Left = [O17].Left + 5
End Select
Case Else: .Left = [L17].Left + 5
End Select
Select Case Sheet16.Range("OverviewLevelOfDetail")
Case 1, 2
.Visible = msoFalse
[OverviewScrollBarVerticalValue] = 1
Case Else
.Visible = msoTrue
.Max = [PT1rng].Rows.Count - 34 'xxx s týmto som mal problém
End Select
End With
End With
Ahoj, základ kódu získaný za pomoci záznamníka makra:Sub Macro1()
ActiveSheet.Shapes.Range(Array("Scroll Bar 1")).Select
With Selection
' .Value = 20
' .Min = 0
.Max = 400
' .SmallChange = 1
' .LargeChange = 10
' .LinkedCell = ""
' .Display3DShading = True
End With
End Sub
U daného objektu (ovládací prvok formulára - posuvník, vložený priamo do listu), potrebujem programovo meniť hodnotu rozsahu do (t.j. tú vlastnosť max). Vedel by mi niekto poradiť, ako na to? Chcel by som to za pomoci načítania toho tvaru do nejakej objektovej premennej aby som sa vyhol príkazu select...
na úrovni listu:=COUNTIF(A:A;"<>"&""), v makre analogicky: WorksheetFunction.CountIf([A:A], "<>" & ""),ale to dáva počet neprázdnych buniek, nie počet buniek s číslami. Asi by si si mal ujasniť, počet čoho vlastne chceš získať
Sub PocetCisel()
MsgBox WorksheetFunction.Count([A:A])
End Sub
2 spôsoby ošetrenia delenia nulou v kóde
1. Bunky s nulovou hodnotou sa do vzorca neprenášajú:Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyFormula As String, cell As Range, iniRng As Range
Set iniRng = [G2]
Set iniRng = Range(iniRng, iniRng.End(xlDown).Offset(1, 0))
If Not Application.Intersect(iniRng, Target) Is Nothing Then
MyFormula = "=1/("
Set cell = [G2]
Do While cell <> ""
If cell.Value <> 0 Then _
MyFormula = MyFormula & "(1/" & cell.Address & ")+"
Set cell = cell.Offset(1, 0)
Loop
MyFormula = Left(MyFormula, Len(MyFormula) - 1) & ")"
[P27].Formula = MyFormula
Set cell = Nothing
End If
Set iniRng = Nothing
End Sub
2. zlomok s nulou v menovateli je do výsledného vzorca zapísaný ako nulaOption Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyFormula As String, cell As Range, iniRng As Range
Set iniRng = [G2]
Set iniRng = Range(iniRng, iniRng.End(xlDown).Offset(1, 0))
If Not Application.Intersect(iniRng, Target) Is Nothing Then
MyFormula = "=1/("
Set cell = [G2]
Do While cell <> ""
If cell.Value <> 0 Then
MyFormula = MyFormula & "(1/" & cell.Address & ")+"
Else: MyFormula = MyFormula & "0+"
End If
Set cell = cell.Offset(1, 0)
Loop
MyFormula = Left(MyFormula, Len(MyFormula) - 1) & ")"
[P27].Formula = MyFormula
Set cell = Nothing
End If
Set iniRng = Nothing
End Suboba ovšem nejakým spôsobom pôvodné zadanie modifikujú a otázkou naďalej zostáva, čo sa vlastne v pôvodnom zadaní ohľadom delenia nulou chcelo
Uživatelské menu
\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