Příspěvky uživatele


< návrat zpět

Strana:  1 2   další »

Aby se vaše aplikace správně otevřené v Access 2010 Runtime, třeba udělat řadu opatření. Musí být převeden první do aplikace Access 2007 a teprve poté do Access 2010. Získejte trpělivost a postupujte podle linku -
http://allenbrowne.com/access2007.html

Správně. Pouze tento řádek

Target.Value = 0

podle mého názoru zbytečné.

Kod je správný. Ale je třeba připominout, že nováček může špatně jeho rozmístit. Podívejte se na obrázek.

Odpověd na vaši otázku se nacházet v archivu.

Všechno je v pořádku. Všechno funguje. Ten kod

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$5" Then
Application.EnableEvents = False
Macro1
Application.EnableEvents = True
End If
End Sub

může být umístěn v Microsoft Visual Basic - VBA Project - List2

Ale nasledujíci
Sub Makro1()

'
' Makro1 Makro
'

'
Sheets("List3").Select
Range("F1").Select
Selection.Copy

Dim PoslRad_2 As Integer
Set L1 = Worksheets("List3")
PoslRad = L1.Cells(65536, 1).End(xlUp).Row

Sheets("List3").Select
Range("A1").Select

For i = 1 To PoslRad
If L1.Cells(i, 1).Value = j Then
j = L1.Cells(i, 1)

End If

Next i

L1.Cells(i, 1) = j

Sheets("List3").Select
Range("A1").Select

PoslRad_2 = L1.Cells(65536, 1).End(xlUp).Row
Cells(PoslRad_2 + 1, 1).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("List2").Select
Range("C5").Select

End Sub

v Microsoft Visual Basic - VBA Project - Modules - Module

Příkládám soubor

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "List2!$C$5" Then
Application.EnableEvents = False
Macro1
Application.EnableEvents = True
End If
End Sub

Můžete změnit a používat následující dva kody:

Sub copytonextsheet()
With Sheets("Sheet2")
n = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(n, "A").Resize(, 4).Value = _
Cells(1, "A").Resize(, 4).Value
End With
End Sub

Sub CopyRowsWithNumbersInG()
Dim X As Long
Dim LastRow As Long
Dim Source As Worksheet
Dim Destination As Worksheet
Dim RowsWithNumbers As Range
Set Source = Worksheets("name")
Set Destination = Worksheets("name")
With Source
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For X = 2 To LastRow
If IsNumeric(.Cells(X, "E").Value) And .Cells(X, "E").Value <> "" Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(X, "E")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(X, "E"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy Destination.Range("A4")
End If
End With
MsgBox "Data has been updated !!", vbExclamation + vbInformation, "Company Name"
End Sub

V kombinaci s následující funkce
Function xlLastRow(Optional WorksheetName As String) As Long

If WorksheetName = vbNullString Then
WorksheetName = ActiveSheet.Name
End If
With Worksheets(WorksheetName)
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
End With

End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range: Set rng = [A1:F10] - stanovit rozsah měnících se buněk
If Not Intersect(rng, Target) Is Nothing Then MyMacro - tady je jmeno vašého makra
End Sub

Chcete-li najít poslední neprazdný řádek v listu, například, ve sloupci A -

Function xlLastRow(Optional WorksheetName As String) As Long

If WorksheetName = vbNullString Then
WorksheetName = ActiveSheet.Name
End If
With Worksheets(WorksheetName)
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
End With

End Function

Spustit z příkazového řadku unRegsvr32 C:\windows\system32\MSCAL.OCX
Kopirovat soubor z přílohy MSCAL.OCX do složky c:\windows\system32
Potom proved'te Regsvr32 C:\windows\system32\MSCAL.OCX
Pokuste přidat kalendář znovu.

Excel 2003: Data - Skupina a přehled -Seskupit
Excel 2010: Data - Osnova - Seskupit

Můžete zaregistrovat na jednu sekundu na tomto webu http://www.ozgrid.com/forum/showthread.php?t=58206&highlight=Dynamic+Chart a stáhněte
DynaChart.xls‎.

Uplatnit Group Outline Columns je možna po -
Sub Macro2()
Dim Sel As Range, cell As Range, n As Byte
Application.ScreenUpdating = False
Set Sel = Selection
If Sel.Rows.Count = 1 Then
For Each cell In Sel
If cell Like ("[1-8]") Then n = cell Else n = 1
cell.EntireColumn.OutlineLevel = n
Next
ElseIf Sel.Columns.Count = 1 Then
For Each cell In Sel
If cell Like ("[1-8]") Then n = cell Else n = 1
cell.EntireRow.OutlineLevel = n
Next
Else
MsgBox "?"
End If
Application.ScreenUpdating = True
End Sub

'Definovat dynamický rozsah proměnných
Dim oUpBound As Range
Dim oLowBound As Range
Dim oFillRange As Range
Dim oChart As ChartObject

Sheets("DataSource").Select
Set oUpBound = Range("C11")
oUpBound.Select
Selection.Offset.End(xlToRight).Select
Selection.Offset.End(xlDown).Select
Set oLowBound = Selection
Set oFillRange = Range(oUpBound, oLowBound)

'Nastavení grafu SourceData
With oChart
.Chart.SetSourceData Source:=Sheets("DataSource").Range(oFillRange), PlotBy:=xlColumns
End With

Žádost kritériem pro filtr
Set wSheetStart = ActiveSheet
Set rFilterHeads = Range("L1", Range("IV1").End(xlToLeft))

With wSheetStart
.AutoFilterMode = False
rFilterHeads.AutoFilter
strCriteria = InputBox("Zadejte kritéria")
If strCriteria = vbNullString Then Exit Sub
rFilterHeads.AutoFilter Field:=3, Criteria1:=strCriteria

End With

nebo

Sub AutoFilter_Begins_With()

Range("A1").AutoFilter Field:=1, Criteria1:="Zadejte kritéria zde*"

End Sub

Kdýž chcete, výsledný kod zkombinujete sami

Podivejte se na přílohu. Naprosto to není těžké. Zpočátku vytvořite graf založený na celou tabulku. Poté musíte použít příkaz Filter (pro filtrovaní na řádek) a Group/VYTVOŘIT.SKUPINU.OBJEKTŮ (pro filtrovaní na sloupce). Filtr použijte pro sloupce A. A potom zvolte bunky PLANOVANE i ORGANIZACE, pak Data-Group and Outline-Group-Columns (DATA-VYTVOŘIT.SKUPINU.OBJEKTŮ I OSNOVA-VYTVOŘIT.SKUPINU.OBJEKTŮ-SLOUPCE) i tlačte minus nahoře.

Datum expirace pro tuto stránku ukončena 10 listopadu 2011. A pak, zdá se, že nezaplatili.

Olda_H, přidejte nový sloupec a zadejte vzorec =KDYŽ(JE.ČISLO(E6),E6,0) a podle tohoto sloupce můžete postavit graf. Podívejte se na přiložený soubor.

Něco takového. Můžete upravit sám.

Sub Macro()

yy = TimeValue("0:00:00")

for yy=TimeValue("0:00:00") to TimeValue("0:10:01") Step TimeValue ("0:00:01")

vaš kod

if yy=TimeValue("0:10:00") then Exit Sub

Next yy

End Sub


Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Čas od do

lubo • 19.4. 16:30

Makro smyčka

MilanKop • 19.4. 10:46

Makro smyčka

elninoslov • 19.4. 9:02

Čas od do

elninoslov • 19.4. 8:46

Čas od do

jarek1111 • 18.4. 13:46

Čas od do

lubo • 18.4. 11:13

Čas od do

jarek1111 • 18.4. 8:32