Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 След.
PowerPivot Ранжир по отфильтрованным данным (в контексте суток), Расчёт RANKX привязать к суткам сквозным образом по всё объектам
 
Вон оно как. Спасибо!
PowerPivot Ранжир по отфильтрованным данным (в контексте суток), Расчёт RANKX привязать к суткам сквозным образом по всё объектам
 
surkenny, да, спасибо, мерой результат, что надо!
А как, для общего развития, понимания концепции, вычисление для столбца сделать, чтобы по каждой строке результат был виден (без MEDIAN)? Собсно как я пытался.
Изменено: vladjuha - 11.11.2021 08:55:03
PowerPivot Ранжир по отфильтрованным данным (в контексте суток), Расчёт RANKX привязать к суткам сквозным образом по всё объектам
 
Применительно к 1,2,3 сен: всего значений за каждые сутки пять [1  3  45  47  99].
Ещё показательны 4,5 сен: там набор из шести [1  3  10  40  47  99]
А моя простая формула считает по всему многообразию (т.е. за все сутки) - семь уникальных:  [1  3  10  40  45  47  99].
В приложении желаемый результат.
PowerPivot Ранжир по отфильтрованным данным (в контексте суток), Расчёт RANKX привязать к суткам сквозным образом по всё объектам
 
Здравствуйте!
Делаю ранжир по столбцу Пр с выборкой по суткам такой формулой:
Код
=RANKX (
   FILTER ('Table';
      [Время (Год)] = 'Table'[Время (Год)] && [Время (День)] =  'Table'[Время (День)]
   );
   'Table'[Пр];
   ;
   ASC;Dense
)

Но считает она по всей совокупности. Как прикрутить контекст суток?

vba Можно ли Массив перевести в байты?, Массив() as Variant. Не про байтовый массив
 
Здравствуйте.
А можно ли как перевести массив (тип Variant) в набор байтов?
Без циклов с cstr и strconv к элементам
Изменено: vladjuha - 23.10.2021 11:26:25
Как отобразить в Msgbox значение ячейки?
 
Workbooks(Полный путь к книге)
Workbooks(Имя книги) , где Имя книги: "Имя книги.расширение" / ActiveWorkbook.Name / ThisWorkbook.Name (если она открыта, конечно)
Изменено: vladjuha - 25.06.2021 18:21:21
Макрос поиска в других файлах не берёт из них нужные значения
 
Может лучше пропишете, какая задача, - так проще и интереснее, чем разбирать чужой громоздкий код. (ну как по мне :)
Или уже F8, F9 - там ответы на все вопросы
Изменено: vladjuha - 25.06.2021 17:22:29
Как заставить макрос выполнять указанное действие столько раз, сколько раз искомое слово встречается на листе
 
Дополнительно
Как заставить макрос выполнять указанное действие столько раз, сколько раз искомое слово встречается на листе
 
Здравствуйте. В примерах снизу ответ - FindNext
Изменено: vladjuha - 25.06.2021 17:04:23
Загрузка файла Excel с таблицей и разделение ее на две части
 
Если вдруг имеется в виду обычное копирование из одной книги в другую, то вот
Код
Sub Macro1()
    Dim f As Variant, PWb As Workbook
    f = Application.GetOpenFilename
    If f = False Then Exit Sub
    Set PWb = Workbooks.Add
    With Workbooks.Open(f, ReadOnly:=True).Worksheets(1)
        Intersect(.UsedRange, .Columns("A:G")).Copy
        PWb.Worksheets(1).Paste
        Intersect(.UsedRange, .Columns("H:K")).Copy
        PWb.Worksheets.Add.Paste
    End With
'    PWb.Worksheets(1).UsedRange.EntireColumn.AutoFit
'    PWb.Worksheets(2).UsedRange.EntireColumn.AutoFit
End Sub
Не применятся пользовательский формат к ячейкам (макрос)
 
Алексей П, из User Defined Function (UDF) нельзя изменить числовой формат ячейки (тот что по ctrl+1)
Код
Public Function ПО_ЦВЕТУ(ByRef Target As Range, ByRef rJ1 As Range, ByRef rK1 As Range) As String
    If Target.Count <> 1 Or Len(Target(1)) = 0 Then Exit Function
'    Application.Volatile True
    Select Case Target.Font.Color
        Case rJ1.Interior.Color
            ПО_ЦВЕТУ = "Д"
        Case rK1.Interior.Color
            ПО_ЦВЕТУ = "Н"
        Case Else
            ПО_ЦВЕТУ = "Я" & Target
    End Select
End Function
Изменено: vladjuha - 24.06.2021 06:20:54
Вставка символа перед числом
 
В порядке бреда: пользовательский формат !Основной;-!Основной;!Основной;!Основной
Применение формата 1.XXX,78 в формулах VBA
 
CDbl(Replace("1.234,56",".","",,1,0))
VBA. Определение связанных полей в исходных данных для вычисляемого элемента сводной таблицы
 
Андрей VG, точно, так собрать пазл и можно, спасибо!
VBA. Определение связанных полей в исходных данных для вычисляемого элемента сводной таблицы
 
Да, спасибо, столбец ID не могу в данном случае использовать, т.к. ID уникальный и будет в сводной общая строка множиться на подстроки с ID. Видимо придётся через промежуточный лист.

А необходимость вызвана тем, что в исходной таблице есть столбец для больших текстовых примечаний и в сводной им просто не место - это будет совершенно не читаемо, да и оно для всех значений и не нужно. Другое дело, если юзер нажмёт на заинтересовавшее его значение в сводной, а ему скрипт над таблицей выведет этот самый комментарий.
Изменено: vladjuha - 12.11.2020 12:56:14
Суммирование из таблиц многие-ко-многим
 
На формулах не шмогла - на vba
Выделить в столбце значения, встречающиеся в другом столбце
 
В УФ на второй список условие проверки: =СЧЁТЕСЛИ($A$1:$A$7;B1)
где $A$1:$A$7 - первый список, B1 - первый элемент второго списка
VBA. UserForm. Контроль ввода даты в TextBox
 
if IsDate
CDate

Зачем шаблоны? Быстро и удобно набирать, мне например, 5/5 - будет 5 мая текущего.
ps Или даже кастомом - одно введённое число доводить до этого числа текущего месяца-года, например.

Код
    Dim Request$, DATEX as Date
    Do
        Request = InputBox("Допустимые форматы:" & vbLf & "Д М Г" & vbTab & "Д/М/Г" & vbTab & "Д.М.Г" & vbTab & "Д,М,Г" & vbTab & "Д-М-Г" & vbLf & vbLf & _
                           "Год и месяц можно опускать:" & vbLf & "Д М" & vbTab & "Д/М" & vbTab & "Д.М" & vbTab & "Д,М" & vbTab & "Д-М" & vbTab & "Д", "Введите дату суток X-1", Format(IIf(Hour(Now) < 8 Or Hour(Now) > 22, Date, Date + 1), "D.MM.YY"))
        If Request = "" Then
            Call CloseThisWorkbookCorrect
        ElseIf IsDate(Request) Then
            DATEX = Request
            If DATEX > DateSerial(1917, 11, 7) Then Exit Do Else Call CloseThisWorkbookCorrect
        ElseIf Val(Request) > 0 And Val(Request) < 32 Then
            DATEX = DateSerial(Year(Date), IIf(Day(Date) > 26, Month(Date) + 1, Month(Date)), Val(Request))
            Exit Do
        End If
    Loop
    DATEX = Int(DATEX)
Изменено: vladjuha - 10.11.2020 19:19:27
Какую функцию применить
 
Цитата
vikttur написал:
vladjuha , а Вы какое название темы предложите?
Как я понял и ответил на вопрос, то "Выбор значений из исходной таблицы по условию количества строк"
Какую функцию применить
 
Я, наверное, не понял вопрос ибо ответ слишком очевидный(
И не понятно, что значит "и не разносит данные введёные после"
VBA. Определение связанных полей в исходных данных для вычисляемого элемента сводной таблицы
 
Здравствуйте!

По двойному щелчку по элементу, находящемуся в вычисляемом поле сводной, откроется лист со всеми связанными исходными данными.

Как на VBA можно обратиться к этим данным (без промежуточного листа, естественно)? В приложенном файле, например, при выделении в сводной ячейки из зелёной группы получить в жёлтой ячейке значение связанного исходного поля "ID" (отсутствует в самой сводной)?
Изменено: vladjuha - 10.11.2020 17:28:07
vba Мониторинг директории в реальном времени, (починка кода)
 
Андрей VG, спасибо за предложенный вариант! Я пока воюю с реализациями на ReadDirectoryChangesW - руки не дошли потестить
vba Мониторинг директории в реальном времени, (починка кода)
 
Я как раз хотел как про сделать :D Через шелдур - это понятно
vba Мониторинг директории в реальном времени, (починка кода)
 
окай...
Поменял я все Long на LongPtr  - компилятор теперь не ругается. Но в полевых испытаниях, при любом изменении в отслеживаемой директории, Excel тупо перезапускается без каких-либо сообщений. Куда двигаться? Any ideas? )
Код
Option Explicit
 
Private Type FILE_NOTIFY_INFORMATION
   NextEntryOffset As LongPtr
   Action As LongPtr
   FileNameLength As Long
   FileName As String
End Type
  
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const FILE_LIST_DIRECTORY = &H1
Private Const FILE_SHARE_READ = &H1&
Private Const FILE_SHARE_DELETE = &H4&
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Private Const FILE_NOTIFY_CHANGE_FILE_NAME = &H1&
Private Const FILE_NOTIFY_CHANGE_LAST_WRITE = &H10&
Private Const FILE_SHARE_WRITE As LongPtr = &H2
Private Const FILE_NOTIFY_CHANGE_ATTRIBUTES As LongPtr = &H4
Private Const FILE_NOTIFY_CHANGE_DIR_NAME As LongPtr = &H2
Private Const FILE_ACTION_ADDED = &H1&
Private Const FILE_ACTION_REMOVED = &H2&
Private Const FILE_ACTION_MODIFIED = &H3&
Private Const FILE_ACTION_RENAMED_OLD_NAME = &H4&
Private Const FILE_ACTION_RENAMED_NEW_NAME = &H5&
 
Private Declare PtrSafe Sub MoveMemory Lib _
"kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpcSource As Any, ByVal dwLength As LongPtr)
 
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As LongPtr
 
Private Declare PtrSafe Function ReadDirectoryChangesW Lib "kernel32" _
(ByVal hDirectory As LongPtr, lpBuffer As Any, ByVal nBufferLength As LongPtr, _
ByVal bWatchSubtree As LongPtr, ByVal dwNotifyFilter As LongPtr, _
lpBytesReturned As LongPtr, ByVal PassZero As LongPtr, ByVal PassZero As LongPtr) As LongPtr
 
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As LongPtr, ByVal dwShareMode As LongPtr, _
ByVal PassZero As LongPtr, ByVal dwCreationDisposition As LongPtr, _
ByVal dwFlagsAndAttributes As LongPtr, ByVal PassZero As LongPtr) As LongPtr
  
Private Declare PtrSafe Function CreateThread Lib "kernel32" _
(lpThreadAttributes As Any, ByVal dwStackSize As LongPtr, _
ByVal lpStartAddress As LongPtr, lpParameter As Any, ByVal dwCreationFlags As LongPtr, _
lpThreadID As LongPtr) As LongPtr
 
Private Declare PtrSafe Function TerminateThread Lib "kernel32" _
(ByVal hThread As LongPtr, ByVal dwExitCode As LongPtr) As LongPtr
 
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As LongPtr, ByVal dwMilliseconds As LongPtr) As LongPtr
 
'Get the directory chages using ReadDirectoryChangesW
Private Const FILE_NOTIF_GLOB = FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                FILE_NOTIFY_CHANGE_FILE_NAME Or _
                                FILE_NOTIFY_CHANGE_DIR_NAME Or _
                                FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                FILE_NOTIFY_CHANGE_LAST_WRITE
 
Private WSubFolder As Boolean
Private nBufLen As Long
Private nReadLen As LongPtr
Private sAction As String
Private fiBuffer As FILE_NOTIFY_INFORMATION
Private cBuffer() As Byte
Private cBuff2() As Byte
Private lpBuf As LongPtr
Private WatchStart As Boolean
Private DirHndl As LongPtr
Private FolderPath As String
Private ThreadHandle As LongPtr
 
Private Function GetDirHndl(ByVal PathDir As String) As LongPtr
 
    On Error Resume Next
 
    Dim hDir As LongPtr
 
    If Right(PathDir, 1) <> "\" Then PathDir = PathDir + "\"
    hDir = CreateFile(PathDir, FILE_LIST_DIRECTORY, _
    FILE_SHARE_READ + FILE_SHARE_WRITE + FILE_SHARE_DELETE, _
    ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS Or FILE_FLAG_OVERLAPPED, ByVal 0&)
    GetDirHndl = hDir
 
End Function
 
Private Sub StartWatch_CallBack()
    If (DirHndl = 0) Or (DirHndl = -1) Then Exit Sub
    nBufLen = 1024
    ReDim cBuffer(0 To nBufLen)
 
    Call ReadDirectoryChangesW(DirHndl, cBuffer(0), nBufLen, WSubFolder, _
    FILE_NOTIF_GLOB, nReadLen, 0, 0)
 
End Sub
 
Private Function GetChanges() As String
 
   On Error Resume Next
   Dim fName As String
 
   MoveMemory fiBuffer.NextEntryOffset, cBuffer(0), 4
   MoveMemory fiBuffer.Action, cBuffer(4), 4
   MoveMemory fiBuffer.FileNameLength, cBuffer(8), 4
   ReDim cBuff2(0 To fiBuffer.FileNameLength)
   MoveMemory cBuff2(0), cBuffer(12), fiBuffer.FileNameLength
   fiBuffer.FileName = cBuff2
 
   Select Case fiBuffer.Action
            Case FILE_ACTION_ADDED
                sAction = "Added file"
            Case FILE_ACTION_REMOVED
                sAction = "Removed file"
            Case FILE_ACTION_MODIFIED
                sAction = "Modified file"
            Case FILE_ACTION_RENAMED_OLD_NAME
                sAction = "Renamed from"
            Case FILE_ACTION_RENAMED_NEW_NAME
                sAction = "Renamed to"
            Case Else
                sAction = "Unknown"
   End Select
 
   fName = sAction + "-" + FolderPath + fiBuffer.FileName
   If sAction <> "Unknown" Then GetChanges = fName
 
End Function
 
Private Sub ClearHndl(Handle As LongPtr)
 
    CloseHandle Handle
    Handle = 0
 
End Sub
 
'______________________________________________________________________________________
Private Sub DisplayInfoOnSheet(i As LongPtr, changes As String)
 
    With ThisWorkbook.Sheets(1)
        .Cells(i, 1) = changes
        .Columns("A:A").EntireColumn.AutoFit
   End With
 
End Sub
 
Sub StartWatch()
 
    Dim changes As String
    Dim WaitNum As LongPtr
    Dim i As LongPtr
 
    WSubFolder = True
    If Not WatchStart Then
        WatchStart = True
    Else
        MsgBox " The Directory Watcher is already enabled", vbInformation
        Exit Sub
    End If
    'Get Folder Handle
    FolderPath = "R:\Dir\" 'change this path as required
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath + "\"
    DirHndl = GetDirHndl(FolderPath)
    If (DirHndl = 0) Or (DirHndl = -1) Then MsgBox "Cannot create handle": Exit Sub
    i = 1
    Do
        'Create thread to Watch changes
        ThreadHandle = CreateThread(ByVal 0&, ByVal 0&, AddressOf StartWatch_CallBack, 0, 0, 0)
        Do
            WaitNum = WaitForSingleObject(ThreadHandle, 50)
            DoEvents
        Loop Until (WaitNum = 0) Or (WatchStart = False)
        changes = ""
        If WaitNum = 0 Then changes = GetChanges
        If changes <> "" Then Call DisplayInfoOnSheet(i, changes): i = i + 1
    Loop Until Not WatchStart
    'Terminate the Thread & Clear Handle
    If DirHndl <> 0 Then ClearHndl DirHndl
    If ThreadHandle <> 0 Then Call TerminateThread(ThreadHandle, ByVal 0&): ThreadHandle = 0
 
End Sub
 
Sub StopWatch()
    WatchStart = False
    With ThisWorkbook.Sheets(1)
        .Columns("A:A").ClearContents
        .Columns("A:A").ColumnWidth = Columns("B:B").ColumnWidth
    End With
 
End Sub
vba Мониторинг директории в реальном времени, (починка кода)
 
Здравствуйте!
Заинтересовался возможностью мониторить определённую директорию на предмет появления новых файлов в реальном времени (ReadDirectoryChangesW).
Подыскал подходящий код, но на него немножко ругается компилятор (win10 x64, excel x64): строка 168, AddressOf StartWatch_CallBack - Type mismatch.
Подскажите, пожалуйста, что где покрутить надобнать?
Код
Option Explicit
 
Private Type FILE_NOTIFY_INFORMATION
   NextEntryOffset As Long
   Action As Long
   FileNameLength As Long
   FileName As String
End Type
 
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const FILE_LIST_DIRECTORY = &H1
Private Const FILE_SHARE_READ = &H1&
Private Const FILE_SHARE_DELETE = &H4&
Private Const OPEN_EXISTING = 3
Private Const CREATE_NEW = 1
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Private Const FILE_NOTIFY_CHANGE_FILE_NAME = &H1&
Private Const FILE_NOTIFY_CHANGE_LAST_WRITE = &H10&
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4
Private Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2
Private Const FILE_ACTION_ADDED = &H1&
Private Const FILE_ACTION_REMOVED = &H2&
Private Const FILE_ACTION_MODIFIED = &H3&
Private Const FILE_ACTION_RENAMED_OLD_NAME = &H4&
Private Const FILE_ACTION_RENAMED_NEW_NAME = &H5&
 
Private Declare PtrSafe Sub MoveMemory Lib _
"kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpcSource As Any, ByVal dwLength As Long)
 
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Declare PtrSafe Function ReadDirectoryChangesW Lib "kernel32" _
(ByVal hDirectory As Long, lpBuffer As Any, ByVal nBufferLength As Long, _
ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, _
lpBytesReturned As Long, ByVal PassZero As Long, ByVal PassZero As Long) As Long
 
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
ByVal PassZero As Long, ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal PassZero As Long) As Long
 
Private Declare PtrSafe Function CreateThread Lib "kernel32" _
(lpThreadAttributes As Any, ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, _
lpThreadID As Long) As Long
 
Private Declare PtrSafe Function TerminateThread Lib "kernel32" _
(ByVal hThread As Long, ByVal dwExitCode As Long) As Long
 
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
 
'Get the directory chages using ReadDirectoryChangesW
Private Const FILE_NOTIF_GLOB = FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                FILE_NOTIFY_CHANGE_FILE_NAME Or _
                                FILE_NOTIFY_CHANGE_DIR_NAME Or _
                                FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                FILE_NOTIFY_CHANGE_LAST_WRITE
 
Private WSubFolder As Boolean
Private nBufLen As Long
Private nReadLen As Long
Private sAction As String
Private fiBuffer As FILE_NOTIFY_INFORMATION
Private cBuffer() As Byte
Private cBuff2() As Byte
Private lpBuf As Long
Private WatchStart As Boolean
Private DirHndl As Long
Private FolderPath As String
Private ThreadHandle    As Long
 
Private Function GetDirHndl(ByVal PathDir As String) As Long
 
    On Error Resume Next
 
    Dim hDir As Long
 
    If Right(PathDir, 1) <> "\" Then PathDir = PathDir + "\"
    hDir = CreateFile(PathDir, FILE_LIST_DIRECTORY, _
    FILE_SHARE_READ + FILE_SHARE_WRITE + FILE_SHARE_DELETE, _
    ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS Or FILE_FLAG_OVERLAPPED, ByVal 0&)
    GetDirHndl = hDir
 
End Function
 
Private Sub StartWatch_CallBack()
    If (DirHndl = 0) Or (DirHndl = -1) Then Exit Sub
    nBufLen = 1024
    ReDim cBuffer(0 To nBufLen)
 
    Call ReadDirectoryChangesW(DirHndl, cBuffer(0), nBufLen, WSubFolder, _
    FILE_NOTIF_GLOB, nReadLen, 0, 0)
 
End Sub
 
Private Function GetChanges() As String
 
   On Error Resume Next
   Dim fName As String
 
   MoveMemory fiBuffer.NextEntryOffset, cBuffer(0), 4
   MoveMemory fiBuffer.Action, cBuffer(4), 4
   MoveMemory fiBuffer.FileNameLength, cBuffer(8), 4
   ReDim cBuff2(0 To fiBuffer.FileNameLength)
   MoveMemory cBuff2(0), cBuffer(12), fiBuffer.FileNameLength
   fiBuffer.FileName = cBuff2
 
   Select Case fiBuffer.Action
            Case FILE_ACTION_ADDED
                sAction = "Added file"
            Case FILE_ACTION_REMOVED
                sAction = "Removed file"
            Case FILE_ACTION_MODIFIED
                sAction = "Modified file"
            Case FILE_ACTION_RENAMED_OLD_NAME
                sAction = "Renamed from"
            Case FILE_ACTION_RENAMED_NEW_NAME
                sAction = "Renamed to"
            Case Else
                sAction = "Unknown"
   End Select
 
   fName = sAction + "-" + FolderPath + fiBuffer.FileName
   If sAction <> "Unknown" Then GetChanges = fName
 
End Function
 
Private Sub ClearHndl(Handle As Long)
 
    CloseHandle Handle
    Handle = 0
 
End Sub
 
'______________________________________________________________________________________
Private Sub DisplayInfoOnSheet(i As Long, changes As String)
 
    With ThisWorkbook.Sheets(1)
        .Cells(i, 1) = changes
        .Columns("A:A").EntireColumn.AutoFit
   End With
 
End Sub
 
Sub StartWatch()
 
    Dim changes As String
    Dim WaitNum As Long
    Dim i As Long
 
    WSubFolder = True
    If Not WatchStart Then
        WatchStart = True
    Else
        MsgBox " The Directory Watcher is already enabled", vbInformation
        Exit Sub
    End If
    'Get Folder Handle
    FolderPath = "C:\test\" 'change this path as required
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath + "\"
    DirHndl = GetDirHndl(FolderPath)
    If (DirHndl = 0) Or (DirHndl = -1) Then MsgBox "Cannot create handle": Exit Sub
    i = 1
    Do
        'Create thread to Watch changes
        ThreadHandle = CreateThread(ByVal 0&, ByVal 0&, AddressOf StartWatch_CallBack, 0, 0, 0)
        Do
            WaitNum = WaitForSingleObject(ThreadHandle, 50)
            DoEvents
        Loop Until (WaitNum = 0) Or (WatchStart = False)
        changes = ""
        If WaitNum = 0 Then changes = GetChanges
        If changes <> "" Then Call DisplayInfoOnSheet(i, changes): i = i + 1
    Loop Until Not WatchStart
    'Terminate the Thread & Clear Handle
    If DirHndl <> 0 Then ClearHndl DirHndl
    If ThreadHandle <> 0 Then Call TerminateThread(ThreadHandle, ByVal 0&): ThreadHandle = 0
 
End Sub
 
Sub StopWatch()
    WatchStart = False
    With ThisWorkbook.Sheets(1)
        .Columns("A:A").ClearContents
        .Columns("A:A").ColumnWidth = Columns("B:B").ColumnWidth
    End With
 
End Sub
Изменено: vladjuha - 25.05.2018 17:02:57
vba Создать объект где все свойства только для чтения, где свойства Class1 есть экземпляры Class2
 
Ах вот для чего нужен это Friend, читал же недавно и не вник.
Спасибо, как всегда!
vba Создать объект где все свойства только для чтения, где свойства Class1 есть экземпляры Class2
 
Здравствуйте.
Посоветуйте, пожалуйста, в следующем.

Есть Class1, в нём определено свойство. Это свойство является экземпляром Class2.
В Class2 также определено свойство, но оно только для чтения.
Я не могу понять, как можно при создании экземпляра Class1 задать значение для свойства из Class2, при условии, что значение для свойства Class2 известно только на этапе создания объекта от Class1.

Для чего это: я хочу собрать объект, где все данные определены в момент инициализации и больше не должны изменяться извне - объект для просмотра только (ну за исключением пары методов).

Я вымучил только через глобальную переменную, поднося на лопате в момент new. Но это ужасно коряво и не годится для большого кол-ва свойств, как можно сделать нормально? Может оставить Property Let, но после создания объекта как-то блокировать попытки записи, вполне сгодилось бы, но как это реализовать?
vba Установить значение UDT-свойства экземпляра класса
 
Будьте добры, ещё такой дополняющий вопрос.
Можно ли создать для класса метод по умолчанию, наподобие, как я могу обращаться к элементу в Dictionary минуя .Item(), т.е. Dic("key") = ... ?

Добавлено:

Со вторым вопросом разобрался, инструкция
А с первым всё ещё интересно: есть ли (академическая) разница между Private d_ As New Class2 и Class_Initialize() Set d_ = New Class2
Изменено: vladjuha - 13.08.2017 03:17:59
vba Установить значение UDT-свойства экземпляра класса
 
AAF, спасибо за конкретное решение.
А есть какой нюансик, между вариантами
Код
Private d_ As Class2
...
Private Sub Class_Initialize()
  Set d_ = New Class2
...
и, если сразу:
Код
Private d_ As New Class2
Может в скорости где выигрыш (если в цикле в большом кол-ве создаются экземпляры, например), или ещё что?
Изменено: vladjuha - 13.08.2017 02:26:36
vba Установить значение UDT-свойства экземпляра класса
 
ZVI, спасибо, теперь стало понятно
Изменено: vladjuha - 12.08.2017 11:12:08
Страницы: 1 2 3 4 5 След.
Наверх