Здравствуйте, в макросах я полный чайник и прошу помощи) На работе есть прекрасная таблица выгружающая из базы R-keeper отчет, но только за 1 день, а нужно за период дат, подскажите пожалуйста, что нужно изменить. Вот сам макрос
Public Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _ (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _ ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _ (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _ ByVal lpString As Any, ByVal lpFileName As String) As Long Sub Get_Server() ' что ишем в вайле ' [BKC File Directory] ' Path=\\10.0.63.2\posdataforbkc ' ActiveWindow.DisplayWorkbookTabs = True Sheets("Setup").Select ActiveSheet.Range("C25").Value = "" ActiveSheet.Range("C25").Value = RIF("Path", "Ошибка", "BKC File Directory", "C:\Program Files (x86)\ICC\POSInterface\PCMinder.INI") If ActiveSheet.Range("C25").Value = "Ошибка" Then ActiveSheet.Range("C25").Value = RIF("Path", "Ошибка", "BKC File Directory", "C:\Program Files\ICC\POSInterface\PCMinder.INI") End If If ActiveSheet.Range("C25").Value = "Ошибка" Then ActiveSheet.Range("C25").Value = RIF("Path", "Сделайте заявку в UCS", "BKC File Directory", "D:\Distr\ICC\POSInterface\PCMinder.INI") End If End Sub Public Function RIF(ByVal sName$, ByVal DefVal$, ByVal sPart$, ByVal FilePath$) As String ' функция ищет в ini файле FilePath$ раздел sPart$, ' и читает из него значение параметра с именем sName$ ' Если такой параметр не найден, возвращается значение по умолчанию DefVal$ Const strNoValue As String = "" Dim intRet As Integer 'Длина возвращаемой строки (функцией GetPrivateProfileString) Dim strRet As String 'Возвращаемая строка 'Получаем значение из файла - если его нет будет возвращен 3й аргумент = strNoValue strRet = String(255, Chr(0)): intRet = GetPrivateProfileString(sPart, sName, strNoValue, strRet, 255, FilePath) strRet = Left$(strRet, intRet) 'Определяем было найдено значение или нет (если возвращено знач. константы strNoValue то = НЕТ) If strRet = strNoValue Then strRet = DefVal 'Значение не было найдено - возвращаем значение по умолчанию RIF = strRet End Function Public Sub WIF(ByVal sName$, ByVal val$, ByVal sPart$, ByVal FilePath$) ' функция ищет в ini файле FilePath$ раздел sPart$ (если раздела нет - он создаётся), ' и добавляет в него параметра с именем sName$ и значением val Dim intRet As Integer: intRet = WritePrivateProfileString(sPart, sName, val, FilePath) 'If intRet <> 1 Then 'Неудачное завершение'(Проверка результата записи) End Sub
Sub Load_All() Call Get_Server Call POS_PMIXloading101 Sheets("MENU").Select MsgBox "Загружено", vbInformation, "yelovik" End Sub
Sub POS_PMIXloading101() Dim sFileName As String Dim sPathName As String Dim sDateMask As String Dim sMonth As String Dim sDay As String Dim maestro As String Dim esclavo2 As String
Application.ScreenUpdating = True On Error GoTo Trapper maestro = ThisWorkbook.Name Call ERASE_PLUDATA If Left(Range("workdir"), 2) = "\\" Then sPathName = Range("workdir") Else sPathName = "\" & Range("workdir") End If
SetCurrentDirectoryA sPathName
If (Range("MonthUpload") < 10) Then sMonth = "0" & Range("MonthUpload") Else sMonth = Range("MonthUpload") End If If (Range("DayUpload") < 10) Then sDay = "0" & Range("DayUpload") Else sDay = Range("DayUpload") End If
Вот "мне надо!", а ознакомиться с порядками времени нет... Правила форума - о файле-примере, о названии темы. Код в сообщении нужно оформлять тэгами (кнопка <...>). Длинные листинги прятать под спойлер (кнопка sp)