Чат kullun

Sub Увеличение()
Dim Начало, Счётчик, Всего As Integer
Dim Наименование() As String
Dim Сумма() As Double
Dim Условие, Текущее, вывод As String
'
' Увеличение размера динамического массива
'

'
Начало = 4
Счётчик = 0
ReDim Наименование(5)
ReDim Сумма(5)
' Начальное количество элементов массива
Всего = UBound(Наименование)
Текущее = Cells(Начало, 3)
Условие = "Бельгия"
Do While Текущее <> ""
If Текущее = Условие Then
Счётчик = Счётчик + 1
If Счётчик > Всего Then
Всего = Всего + 10
' Увеличение размера массива
ReDim Preserve Наименование(Всего)
ReDim Preserve Сумма(Всего)
End If
' Запоминание элементов массива
Наименование(Счётчик) = Cells(Начало, 1)
Сумма(Счётчик) = Cells(Начало, 5)
End If
Начало = Начало + 1
Текущее = Cells(Начало, 3)
Loop
' Вывод результатов
вывод = MsgBox("Всего " & CInt(Счётчик))
вывод = MsgBox("Второй элемент " & Наименование(2))
End Sub

Новое в версии 2016:
Even faster than before
Flexible graphics editing with the new SoftMaker Office
Pivot tables and more math functions in the new version of PlanMaker
Preview documents and pictures before opening them
Charts can now be created in TextMaker and Presentations, too
Touchscreens, high-resolution monitors, and more
Huge worksheets in the new PlanMaker
Improved user interface in SoftMaker Office
The new SoftMaker Office has EPUB and enhanced PDF export
Extended toolbars in the new SoftMaker Office
The new TextMaker makes it easier to work on tables
Improved backup, including version management
Smart guides in the new version of Presentations
The new SoftMaker Office offers you a huge choice of first-class templates
SoftMaker Office 2016 has even better compatibility with Microsoft Office

http://profismart.org/web/f-196190.php


Облегченная семерка для слабых ПК

Sub FindDoljnost(str As String)
Dim rst As ADODB.Recordset
Dim strSearch As String
strSearch = "Должность = '" & str & "'"
Set rst = New ADODB.Recordset

With rst
.Open "Сотрудники", CurrentProject.Connection, adOpenStatic, adLockPessimistic
.MoveFirst
.Find strSearch

Do Until .EOF
Debug.Print rst("ФИОСотрудника")
.Find strSearch, 1
Loop

End With

rst.Close
Set rst = Nothing
End Sub

Option Compare Database
Option Explicit

Sub Printclients()
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "", CurrentProject.Connection
rst.MoveFirst
Do Until rst.EOF
Debug.Print rst(1)
rst.MoveNext
Loop

rst.Close
Set rst = Nothing


End Sub

c ошибкой без учета конца EOF ( if rst.EOF = false)


Option Compare Database
Option Explicit

Sub Printclients()
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "", CurrentProject.Connection
rst.MoveFirst
Do
Debug.Print rst(1)
rst.MoveNext
Loop

rst.Close
Set rst = Nothing


End Sub

Public Function RecordSetCopyToVirtual(ByRef recordSetSource As ADODB.Recordset, _
Optional ByRef FieldsToAdd As Fields) As ADODB.Recordset
On Error GoTo ERR_HAND
Dim Rs As ADODB.Recordset
Dim RsFiled As ADODB.Field

Set Rs = New ADODB.Recordset

Rs.CursorLocation = adUseClient
Rs.CursorType = adOpenStatic

'Добавление полей
For Each RsFiled In recordSetSource.Fields
Rs.Fields.Append RsFiled.Name, RsFiled.Type, RsFiled.DefinedSize
With Rs.Fields(RsFiled.Name)
.Attributes = RsFiled.Attributes
.DefinedSize = .DefinedSize
.NumericScale = RsFiled.NumericScale
.Precision = RsFiled.Precision
End With
Next

'Добавление новых полей
If Not FieldsToAdd Is Nothing Then
For Each RsFiled In FieldsToAdd
Rs.Fields.Append RsFiled.Name, RsFiled.Type, RsFiled.DefinedSize

With Rs.Fields(RsFiled.Name)
.Attributes = RsFiled.Attributes
.DefinedSize = .DefinedSize
.NumericScale = RsFiled.NumericScale
.Precision = RsFiled.Precision
End With
Next
End If

'Открытие набора
Rs.Open

'Добавление записей в набор
recordSetSource.MoveFirst
Do While Not recordSetSource.EOF
Rs.AddNew
For Each RsFiled In recordSetSource.Fields
If Not IsNull(recordSetSource.Fields(RsFiled.Name).Value) Then
Rs.Fields(RsFiled.Name).Value = recordSetSource.Fields(RsFiled.Name).Value
End If
Next

recordSetSource.MoveNext
Loop

Set RecordSetCopyToVirtual = Rs

On Error GoTo 0
Exit Function

ERR_HAND:
Err.Raise Err.Number, "RecordSetCopyToVirtual", Err.Description
End Function

врменно:
Языки: http://cwer.ru/node/449179/

временно Электроника:
http://cwer.ru/node/406323/
http://cwer.ru/node/438095/
http://cwer.ru/node/310063/
http://cwer.ru/node/139471/
http://cwer.ru/node/376994/
http://cwer.ru/node/444682/

Временно:
http://cwer.ru/node/447832/
http://cwer.ru/node/448019/
http://cwer.ru/node/448336/
http://cwer.ru/node/448289/

http://cwer.ru/node/448336/
http://cwer.ru/node/448668/