Zpět na obsah
Zpět na obsah
Zpět na obsah
Zpět na obsah Funkce Public Function GetRecordset(rs As ADODB.Recordset) As ADODB.Recordset Dim fld As ADODB.Field, lRs As ADODB.Recordset Set lRs = New ADODB.Recordset For Each fld In rs.Fields With lRs .Fields.Append fld.name, fld.Type, fld.DefinedSize, fld.Attributes If fld.Type = adNumeric Or fld.Type = adDecimal Then .Fields(.Fields.Count - 1).Precision = fld.Precision .Fields(.Fields.Count - 1).NumericScale = fld.NumericScale End With Next fld End Function Funkce Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _ (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function mciGetErrorString Lib "winmm" Alias _ "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _ ByVal uLength As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias _ "GetShortPathNameA" (ByVal lpszLongPath As String, _ ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long Public Sub PlayAVI(ByVal strFile As String, Optional ByVal audio As Boolean = True) Dim ret As Long, mciCommand As String, shortFile As String * 255 ret = GetShortPathName(strFile, shortFile, Len(shortFile)) strFile = Left(shortFile, ret) ret = mciSendString("Open " & strFile & " type avivideo alias AVIFile", vbNullString, 0, 0&) If Not audio Then ret = mciSendString("Set AVIFile audio all off", vbNullString, 0, 0&) ret = mciSendString("Play AVIFile wait", vbNullString, 0, 0&) ret = mciSendString("Close AVIFile", vbNullString, 0, 0&) End Sub Je zapnuta funkce ActiveDesktop Co je to ActiveDesktop ví určitě každý z vás. Již od Windows 98 má tuto možnost
každá nová verze Windows. Funkce Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long Public Function ActiveDesktop() As Boolean Dim hWnd As Long hWnd = FindWindowEx(0, 0, "Progman", vbNullString) If hWnd Then hWnd = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", vbNullString) If hWnd Then If FindWindowEx(hWindow, 0, "Internet Explorer_Server", vbNullString) Then ActiveDesktop = True End If End If End If End Function Chcete-li vytisknout data nějakého objektu, např z dotazu, použijte objekt Dim mac As Access.Application mac.OpenCurrentDatabase "C:\data.mdb" With mac.DoCmd .OpenQuery "qryZamestnanci" .SelectObject acQuery, "qryZamestnanci" .PrintOut acPrintAll End With |