Příspěvky uživatele
< návrat zpět
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
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