| |
Без коментариев
В данном разделе интересные решения и куски кода,
которые жалко потерять но и проверить до конца на
предмет наличия "подводных камней" и подробно описать
тонкости нет времени.
Вероятно их будет сложно понять непосвященным.
Именно поэтому я несколько отдалил этот раздел.
Защитить Word документ используемый в качестве отчета от измененеий
1 . WRD.Protect Type:=wdAllowOnlyFormFields
2. Password :="Пароль"
Скачать с FTP
Запустить из коммандной строки или через Shell программно.
ftp -i -s:FTP_SCR.TXT
FTP_SCR.TXT:
open 000.000.000.000
логин
пасворд
binary
get /путь_там путь здесь
rem например get /swop/tar.tar.gz c:/tar.tar.gz
quit
Макросы в Аксесс могут начать выдавать ошибки (MDB, ADP)
Хотя на другом компьютере программа работает
Например:
Функция RunCode может не находить имя функции.
Причина:
На компьютере не установлен MSJET SP8 (в комплекте MDAC 2.8 не поставляется, в состав Аксесса и сервис-паков не входит)
Загрузить можно только отдельно : http://support.microsoft.com/default.aspx?scid=kb;en-us;829558
Поиск процесса приложения (загружен ли MSWORD) by baike2000
Const TH32CS_SNAPHEAPLIST As Long = 1 ' включить список куч в снапшот
Const TH32CS_SNAPPROCESS As Long = 2 ' включить списко процессов
Const TH32CS_SNAPTHREAD As Long = 4 ' включить список тредов
Const TH32CS_SNAPMODULE As Long = 8 ' включить список модулей
Const TH32CS_SNAPALL As Long = 1 Or 2 Or 4 Or 8 ' в снапшот будет включено все
Const TH32CS_INHERIT As Long = &H80000000 ' снапшот может наследоваться
Type PROCESSENTRY32
size As Long ' размер структур - нужно установить до вызова
usage As Long ' ссылок на процесс - живет, пока не равно нулю
processid As Long ' PID
defaultHeapID As Long ' ID кучи процесса по умолчанию
moduleID As Long ' MID :))
threads As Long ' количество запущенных процессом тредов
parentProcessID As Long ' PID процесса, создавшего наш процесс
priClassBase As Long ' базовый приоритет тредов
flags As Long ' зарезервировано
exeFile As String * 255 ' лучшее напоследок - полный путь к процессам!
End Type
Declare Function CreateToolhelp32Snapshot Lib "Kernel32.dll" (ByVal dwFlag As Long, ByVal processid As Long) As Long
Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Boolean
Declare Function Process32First Lib "Kernel32.dll" (ByVal hSnapShot As Long, ByRef Procentry32 As PROCESSENTRY32) As Boolean
Declare Function Process32Next Lib "Kernel32.dll" (ByVal hSnapShot As Long, ByRef Procentry32 As PROCESSENTRY32) As Boolean
Function FindProcess(strProcess As String) As Boolean
Dim flag As Boolean, hSnap As Long
Dim Procentry As PROCESSENTRY32
hSnap = CreateToolhelp32Snapshot(2, 0)
flag = False
Procentry.size = 291
If Process32First(hSnap, Procentry) Then
If InStr(UCase(Procentry.exeFile), UCase(strProcess)) <> 0
Then flag = True
While (Not flag) And (Process32Next(hSnap, Procentry))
If InStr(UCase(Procentry.exeFile), UCase(strProcess)) <> 0 Then
flag = True
End If
Wend
End If
CloseHandle hSnap
FindProcess = flag
End Function
Private Sub IsProcess()
If FindProcess("WINWORD.EXE") Then MsgBox "Найден" Else MsgBox "Не найден" End Sub
Динамическое изменение размеров формы
src: http://www.msaccess.ru/UserInterfase_Dinamic_Scr.html
Option Compare Database
Option Explicit
Private Declare Function apiGetSys Lib "user32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Const SM_CYCAPTION = 4
Private Const SM_CXBORDER = 5
Private Const SM_CYBORDER = 6
Private Const SM_CXDLGFRAME = 7
Private Const SM_CYDLGFRAME = 8
Private Const SM_CYVTHUMB = 9
Private Const SM_CXHTHUMB = 10
Private Const SM_CXICON = 11
Private Const SM_CYICON = 12
Private Const SM_CXCURSOR = 13
Private Const SM_CYCURSOR = 14
Private Const SM_CYMENU = 15
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
Private Const SM_CYKANJIWINDOW = 18
Private Const SM_MOUSEPRESENT = 19
Private Const SM_CYVSCROLL = 20
Private Const SM_CXHSCROLL = 21
Private Const SM_DEBUG = 22
Private Const SM_SWAPBUTTON = 23
Private Const SM_RESERVED1 = 24
Private Const SM_RESERVED2 = 25
Private Const SM_RESERVED3 = 26
Private Const SM_RESERVED4 = 27
Private Const SM_CXMIN = 28
Private Const SM_CYMIN = 29
Private Const SM_CXSIZE = 30
Private Const SM_CYSIZE = 31
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33
Private Const SM_CXMINTRACK = 34
Private Const SM_CYMINTRACK = 35
Private Const SM_CXDOUBLECLK = 36
Private Const SM_CYDOUBLECLK = 37
Private Const SM_CXICONSPACING = 38
Private Const SM_CYICONSPACING = 39
Private Const SM_MENUDROPALIGNMENT = 40
Private Const SM_PENWINDOWS = 41
Private Const SM_DBCSENABLED = 42
Private Const SM_CMOUSEBUTTONS = 43
Private Const SM_CMETRICS = 44
Function fGetSysStuff(strWhat As String) As String
Dim strRet As String
Select Case LCase(strWhat)
Case "resolution": strRet = apiGetSys(SM_CXSCREEN) & "*" _
& apiGetSys(SM_CYSCREEN)
Case "windowsize": strRet = apiGetSys(SM_CXFULLSCREEN) & "*" _
& apiGetSys(SM_CYFULLSCREEN)
End Select
fGetSysStuff = strRet
End Function
Sub ТрансформироватьФорму(frm As Form, var_РазрешениеЭкранаНаКотороеНастроенаФорма As String)
Dim КоэффициентТрансформации As Double
If fGetSysStuff("resolution") <> var_РазрешениеЭкранаНаКотороеНастроенаФорма Then
КоэффициентТрансформации = NSA_SCR_КоэффициэнтТрансформации(var_РазрешениеЭкранаНаКотороеНастроенаФорма, fGetSysStuff("resolution"))
Call Динамически_ТрансформироватьФорму(frm, КоэффициентТрансформации)
End If
End Sub
Sub Динамически_ТрансформироватьФорму(frm As Form, var_КоэффициэнтТрансформации As Double)
On Error GoTo Err_Динамически_ТрансформироватьФорму
Dim ctr As Control
Dim i As Variant
Dim j As Variant
Dim var_ШиринаФормы As Double
Dim var_FormName As String
Dim ЕстьЛиЗаголовокФормы As Boolean
Dim ЕстьЛиПримечаниеФормы As Boolean
Dim ЕстьЛиВерхнийКолонтитулФормы As Boolean
Dim ЕстьЛиНижнийКолонтитулФормы As Boolean
Dim ВысотаОбластиДанных As Double
Dim ВысотаЗаголовкаФормы As Double
Dim ВысотаПримечанияФормы As Double
Dim ВысотаВерхнегоКолонтитулаФормы As Double
Dim ВысотаНижнегоКолонтитулаФормы As Double
Dim Max
Dim Size
var_FormName = frm.Name
var_ШиринаФормы = frm.Width
ВысотаОбластиДанных = frm.Section(0).Height
ЕстьЛиЗаголовокФормы = False
On Error GoTo МеткаНетЗаголовкаФормы
ВысотаЗаголовкаФормы = frm.Section(1).Height
ЕстьЛиЗаголовокФормы = True
GoTo ПроверкаПримечанияФормы
МеткаНетЗаголовкаФормы:
Resume ПроверкаПримечанияФормы
ПроверкаПримечанияФормы:
ЕстьЛиПримечаниеФормы = False
On Error GoTo МеткаНетПримечанияФормы
ВысотаПримечанияФормы = frm.Section(2).Height
ЕстьЛиПримечаниеФормы = True
GoTo ПроверкаВерхнегоКолонтитулаФормы
МеткаНетПримечанияФормы:
Resume ПроверкаВерхнегоКолонтитулаФормы
ПроверкаВерхнегоКолонтитулаФормы:
ЕстьЛиВерхнийКолонтитулФормы = False
On Error GoTo МеткаНетВерхнегоКолонтитулаФормы
ВысотаВерхнегоКолонтитулаФормы = frm.Section(3).Height
ЕстьЛиВерхнийКолонтитулФормы = True
GoTo ПроверкаНижнегоКолонтитулаФормы
МеткаНетВерхнегоКолонтитулаФормы:
Resume ПроверкаНижнегоКолонтитулаФормы:
ПроверкаНижнегоКолонтитулаФормы:
ЕстьЛиНижнийКолонтитулФормы = False
On Error GoTo МеткаНетНижнегоКолонтитулаФормы
ВысотаНижнегоКолонтитулаФормы = frm.Section(3).Height
ЕстьЛиНижнийКолонтитулФормы = True
GoTo ОконченаПроверка
МеткаНетНижнегоКолонтитулаФормы:
Resume ОконченаПроверка
ОконченаПроверка:
On Error GoTo Err_Динамически_ТрансформироватьФорму
Dim КолЭлУпр As Long
КолЭлУпр = frm.Controls.Count
ReDim МассивЭлементов(1 To 7, 0 To КолЭлУпр - 1) As Double
Dim kolWkl As Long
kolWkl = 0
For i = 0 To КолЭлУпр - 1
Set ctr = frm.Controls(i)
If ctr.ControlType = acPage Then
МассивЭлементов(1, kolWkl) = i
МассивЭлементов(2, kolWkl) = ctr.Top
МассивЭлементов(3, kolWkl) = ctr.Left
МассивЭлементов(4, kolWkl) = ctr.Width
МассивЭлементов(5, kolWkl) = ctr.Height
МассивЭлементов(6, kolWkl) = 0
For Each j In ctr.Properties
If j.Name = "FontSize" Then
МассивЭлементов(6, kolWkl) = -1
МассивЭлементов(7, kolWkl) = ctr.FontSize
Exit For
End If
Next j
kolWkl = kolWkl + 1
End If
Next i
For i = 0 To КолЭлУпр - 1
Set ctr = frm.Controls(i)
If ctr.ControlType = acTabCtl Then
МассивЭлементов(1, kolWkl) = i
МассивЭлементов(2, kolWkl) = ctr.Top
МассивЭлементов(3, kolWkl) = ctr.Left
МассивЭлементов(4, kolWkl) = ctr.Width
МассивЭлементов(5, kolWkl) = ctr.Height
МассивЭлементов(6, kolWkl) = 0
For Each j In ctr.Properties
If j.Name = "FontSize" Then
МассивЭлементов(6, kolWkl) = -1
МассивЭлементов(7, kolWkl) = ctr.FontSize
Exit For
End If
Next j
kolWkl = kolWkl + 1
End If
Next i
For i = 0 To КолЭлУпр - 1
Set ctr = frm.Controls(i)
If ctr.ControlType <> acTabCtl And ctr.ControlType <> acPage Then
МассивЭлементов(1, kolWkl) = i
МассивЭлементов(2, kolWkl) = ctr.Top
МассивЭлементов(3, kolWkl) = ctr.Left
МассивЭлементов(4, kolWkl) = ctr.Width
МассивЭлементов(5, kolWkl) = ctr.Height
МассивЭлементов(6, kolWkl) = 0
For Each j In ctr.Properties
If j.Name = "FontSize" Then
МассивЭлементов(6, kolWkl) = -1
МассивЭлементов(7, kolWkl) = ctr.FontSize
Exit For
End If
Next j
kolWkl = kolWkl + 1
End If
Next i
On Error Resume Next
frm.Width = var_ШиринаФормы + var_ШиринаФормы * var_КоэффициэнтТрансформации
frm.Section(0).Height = ВысотаОбластиДанных + ВысотаОбластиДанных * var_КоэффициэнтТрансформации
If ЕстьЛиЗаголовокФормы Then
frm.Section(1).Height = ВысотаЗаголовкаФормы + ВысотаЗаголовкаФормы * var_КоэффициэнтТрансформации
End If
If ЕстьЛиПримечаниеФормы Then
frm.Section(2).Height = ВысотаПримечанияФормы + ВысотаПримечанияФормы * var_КоэффициэнтТрансформации
End If
If ЕстьЛиВерхнийКолонтитулФормы Then
frm.Section(3).Height = ВысотаВерхнегоКолонтитулаФормы + ВысотаВерхнегоКолонтитулаФормы * var_КоэффициэнтТрансформации
End If
If ЕстьЛиНижнийКолонтитулФормы Then
frm.Section(4).Height = ВысотаНижнегоКолонтитулаФормы + ВысотаНижнегоКолонтитулаФормы * var_КоэффициэнтТрансформации
End If
For i = КолЭлУпр - 1 To 0 Step -1
Set ctr = frm.Controls(МассивЭлементов(1, i))
'От верхнего края
ctr.Top = МассивЭлементов(2, i) + МассивЭлементов(2, i) * var_КоэффициэнтТрансформации
'От левого края
ctr.Left = МассивЭлементов(3, i) + МассивЭлементов(3, i) * var_КоэффициэнтТрансформации
'Ширина
ctr.Width = МассивЭлементов(4, i) + МассивЭлементов(4, i) * var_КоэффициэнтТрансформации
'Высота
ctr.Height = МассивЭлементов(5, i) + МассивЭлементов(5, i) * var_КоэффициэнтТрансформации
If ctr.Top > Max Then
Max = ctr.Top
Size = ctr.Height
End If
If МассивЭлементов(6, i) = -1 Then
ctr.FontSize = МассивЭлементов(7, i) + МассивЭлементов(7, i) * var_КоэффициэнтТрансформации
If var_КоэффициэнтТрансформации = -0.2 Then ctr.FontName = "SmallFonts"
End If
Next i
frm.Width = var_ШиринаФормы + var_ШиринаФормы * var_КоэффициэнтТрансформации
frm.Section(0).Height = ВысотаОбластиДанных + ВысотаОбластиДанных * var_КоэффициэнтТрансформации
If ЕстьЛиЗаголовокФормы Then
frm.Section(1).Height = ВысотаЗаголовкаФормы + ВысотаЗаголовкаФормы * var_КоэффициэнтТрансформации
End If
If ЕстьЛиПримечаниеФормы Then
frm.Section(2).Height = ВысотаПримечанияФормы + ВысотаПримечанияФормы * var_КоэффициэнтТрансформации
End If
If ЕстьЛиВерхнийКолонтитулФормы Then
frm.Section(3).Height = ВысотаВерхнегоКолонтитулаФормы + ВысотаВерхнегоКолонтитулаФормы * var_КоэффициэнтТрансформации
End If
If ЕстьЛиНижнийКолонтитулФормы Then
frm.Section(4).Height = ВысотаНижнегоКолонтитулаФормы + ВысотаНижнегоКолонтитулаФормы * var_КоэффициэнтТрансформации
End If
frm.InsideWidth = frm.Width
frm.InsideHeight = Max + 1.5 * Size
DoCmd.MoveSize (apiGetSys(SM_CXSCREEN) * 20 - frm.InsideWidth) / 16, (apiGetSys(SM_CYSCREEN) * 20 - frm.InsideHeight) / 16
Exit_Динамически_ТрансформироватьФорму:
Exit Sub
Err_Динамически_ТрансформироватьФорму:
MsgBox Err.Description
Resume Exit_Динамически_ТрансформироватьФорму
End Sub
Function NSA_SCR_КоэффициэнтТрансформации(var_ИсходныйРазмерЭкрана As String, var_КонечныйРазмерЭкрана As String) As Double
On Error GoTo Err_NSA_SCR_КоэффициэнтТрансформации
'Функция возвращает коэффициэнт увеличения (или уменьшения) размеров и позиций элементов управления
'в формах для преобразования из одного размера экрана в другой.
'Возможные варианты размеров экрана:
' "640*480"
' "800*600"
' "1024*768"
' "1280*1024"
Dim a As Double
Select Case var_ИсходныйРазмерЭкрана
Case "640*480"
Select Case var_КонечныйРазмерЭкрана
Case "640*480"
a = 0
Case "800*600"
a = 0.25
Case "1024*768"
a = 0.6
Case "1280*1024"
a = 1
Case Else
a = 0
End Select
Case "800*600"
Select Case var_КонечныйРазмерЭкрана
Case "640*480"
a = -0.2
Case "800*600"
a = 0
Case "1024*768"
a = 0.28
Case "1280*1024"
a = 0.6
Case Else
a = 0
End Select
Case "1024*768"
Select Case var_КонечныйРазмерЭкрана
Case "640*480"
a = -0.375
Case "800*600"
a = -0.21875
Case "1024*768"
a = 0
Case "1280*1024"
a = 0.25
Case Else
a = 0
End Select
Case "1280*1024"
Select Case var_КонечныйРазмерЭкрана
Case "640*480"
a = -0.5
Case "800*600"
a = -0.375
Case "1024*768"
a = -0.2
Case "1280*1024"
a = 0
Case Else
a = 0
End Select
Case Else
a = 0
End Select
NSA_SCR_КоэффициэнтТрансформации = a
Exit_NSA_SCR_КоэффициэнтТрансформации:
Exit Function
Err_NSA_SCR_КоэффициэнтТрансформации:
MsgBox Err.Description
Resume Exit_NSA_SCR_КоэффициэнтТрансформации
End Function
проверено 1024-> 640 работает реально уменьшает. только подформы разумеется не трогает и шрифт становится безумно мелким... но это уже кое что .
| |
