| |
|
|
| | Собственно хочется вместо прогресбара вызвать ави типа копирования файлов - ну это когда из папки в папку летит листок.
Помнится на делфи а делал такое. А на вба можно? 
ps. Win XP | |
| |
| |
| |
|
|
| | Вот нашел что-то
Option Explicit
Dim i As Integer
Private Sub Command1_Click()
If i = 0 Then
Command1.Caption = "Удалить файл"
With Animation1
.Stop
.Visible = False
.Open (App.Path & "\One.avi")
.Visible = True
.Play
End With
i = i + 1
Else
Command1.Caption = "Очистить корзину"
With Animation1
.Stop
.Visible = False
.Open (App.Path & "\Two.avi")
.Visible = True
.Play
End With
i = 0
End If
End Sub
'Библ. Animation (Microsoft Windows Common Control-2 5.0)
|
НЕ то. И библ. такой нет. | |
| |
| |
| |
|
|
| | Option Explicit
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const FO_COPY = &H2
Public Function apiFileCopy(src As String, dest As String, _
Optional NoConfirm As Boolean = False) As Boolean
'PARAMETERS: src: Source File (FullPath)
'dest: Destination File (FullPath or directory)
'NoConfirm (Optional): If set to
'true, no confirmation box
'is displayed when overwriting
'existing files, and no
'copy progress dialog box is
'displayed
'Returns (True if Successful, false otherwise)
Dim WinType_SFO As SHFILEOPSTRUCT
Dim lRet As Long
Dim lflags As Long
lflags = FOF_ALLOWUNDO
If NoConfirm Then lflags = lflags & FOF_NOCONFIRMATION
With WinType_SFO
.wFunc = FO_COPY
.pFrom = src
.pTo = dest
.fFlags = lflags
End With
lRet = SHFileOperation(WinType_SFO)
apiFileCopy = (lRet = 0)
End Function | |
| |
| |
| |
|
|
| | сапсибо. работает.  | |
| |
| |
|
|
