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

Страницы: 1
Перенос db Access в WEB MS SQL, Просто перенести готовую ДБ на хостинг, Предложение работы
 
Кросс-пост http://forum.vingrad.ru/forum/topic-392207/anchor-entry2673399/0.html
Доброго времени суток, товарищи форумчане. Ищу либо подробную инструкцию, либо человека который готов помочь за определенную сумму денежных средств. Я никогда не переносил БД в серверную форму, не ставил MS SQL Экспресс и не до конца понимаю его ограничения и вообще немного ламер.

В исходнике
1. Написанная мной DB MS Access 2007, которая работает в локалке и увеличивает трафик сети безбожно, при подключении более 3 человек банальный поиск по полю осуществляется секунд 5-9.
2. База юридических лиц никогда не будет весить более 4Гб, она содержит только текстовые данные и будет прибавлять от силы 100МБ в год, сейчас она весит 20 МБ.
3. Появилась идея нанять удаленных сотрудников, чтобы они не появлялись в офисе, а как следствие вынести БД куда нибудь в WEB. Соответственн нужен хостинг который поддержит Аксесс, нужно настроить его, выгрузить туда БД, настроить MS SQL Сервер и радоваться жизни, раздав всем клиентов в ACCESS и нанимая удаленных сотрудников.  
Макрос .Autofilter при запуске не повторяет записанного действия, Ошибка в работе записи макроса.
 
Написал в заголовке что тему рассматривают еще и в другом месте.
Изменено: wirstein - 15.08.2017 22:43:26
Макрос .Autofilter при запуске не повторяет записанного действия, Ошибка в работе записи макроса.
 
А чем плох кросс если мне интересно мнение лиц с двух форумов?
Макрос .Autofilter при запуске не повторяет записанного действия, Ошибка в работе записи макроса.
 
Вопрос так же рассматривается так же на другом форуме: http://www.excelworld.ru/forum/10-34916-1#228565

Доброго дня. Передо мной стоит тривиальная задача, через VBA проводить фильтрацию по полю дат в таблице. Я просто записал макрос и он получился такой вот.

ActiveSheet.ListObjects("Table_fees").Range.AutoFilter Field:=4, Criteria1:=">=11.01.2016", Operator:=xlAnd, Criteria2:="<=01.10.2017"

При повторном запуске макрос просто отфильтровывает все записи и их остается 0 целых 0 десятых. При выполнении того же действия вручную - записей несколько.
Причем в обоих случаях текст фильтра, отражаемый на кнопке фильтрации одинаков.

Я пробовал переделывать скрипт в таком вот виде. Но это тоже не помогло.
ActiveSheet.ListObjects("Table_fees").Range.AutoFilter Field:=4, Criteria1:=">=" & DateValue("01/11/2016"), Operator:=xlAnd, Criteria2:="<=" & DateValue("01/10/2017")

При этом основная задача запустить этот макрос из ACCESS VBA, где в самых разных вариациях его запуска я вижу Error 1004, AutoFilter method of range class failed
.ActiveSheet.ListObjects("Table_fees").Range.Select
.Selection.AutoFilter Field:=4, Criteria1:=">=12.04.2016", Operator:=xlAnd, Criteria2:="<=11.01.2017"

Все остальное - такое как заполнение нужных ячеек и диапазонов нужными числами - работает отлично. Все кроме автофильтрации.
Прошу помочь по данному вопросу, кто сталкивался и кто смог и как решить.

На стадии экселя вопрос был решен через функцию Формат Criteria1:=">=" & Format("11.04.2016", "#####"), Operator:=xlAnd, Criteria2:="<=" & Format("10.04.2017", "#####")

На стадии VBA так и не решен
Изменено: wirstein - 15.08.2017 16:13:55
Создание и заполнение шаблона Word данными через VBA, Решение для массовой генерации договоров или других документов.
 
Всем привет. Написал отдельный модуль (класс), вроде работает. Прикладываю в спойлер.

Ну и пример использования. Если кто найдет ошибку, с радостью приму комментарии
Код
Set act = New WordGenerator
With act
 .template_add "\court\иск.docx" 'Добавили шаблон в папке \templates\ проекта
 .template_add "С:\претензия.docx" 'добавили шаблон абсолютного пути
 .dialog = True 'И этого нам мало, мы спрашиваем юзера, чтобы тоже указал шаблоны
 .multiselect = True 'да и пусть еще мог бы выбрать сразу несколько в диалоговом окне
 .closeafter = True 'Юзер не хочет редактировать готовый файл, закрываем его
 .marker = "Иванов 2017" 'а это припишется к каждому создаваемому файлу
 .SetSaveFolder = "\Все по Иванову\"  'а это папка, куда будет складываться все с этого объекта

 .pair_add "ФИО", "Иванов Иван Иванович"  'парочка пар на замену, можно и сотню
 .pair_add "[должность]", "директор"

 .Start 'запускаем процесс, смотрим как открываются ворд файлики, 
         'производятся замены. сохраняется и закрывается, результат ищем в папках
End With

Скрытый текст
Функция написания числа текстом для бухгалтеров, Функция пишет переданное ей число текстом в скобках с рублями и копейками
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

Благодарю за участие. Все замечания учтены, исходник исправлен. Теперь:
1. Максимальное число до миллиарда (не включая миллиард)
2. Двойных пробелов не будет
3. Округление таких чисел происходит заранее
4. Ноль выдает
5. С отрицательными числами работаем корректно, внесли некоторое изменение
6. Были случаи передачи туда Null потому на всякий сделал так, в случае нула - присваиваем ноль принудительно.
Функция написания числа текстом для бухгалтеров, Функция пишет переданное ей число текстом в скобках с рублями и копейками
 
Написал функцию, которая по надобности превращает число в различные варианты написания, по умолчанию
RUR2TEXT(-504.21) = "-504 (Минус пятьсот четыре) рубля 21 копейка"
При переборе дополнительных параметров можно убирать скобки, рубли и копейки, и цифры, оставляя только текст.
Сам долго искал ее в таком виде, не нашел, потому написал римейк найденного ранее. И тем кто также будет искать, надеюсь облегчу жизнь :)
Комментарии по коду для переделок весьма обильные.
Просто скопировать код, создав новый модуль.
Код
Attribute VB_Name = "Float2String"
 
'В функцию можно передать число, чтобы она написала его по умолчанию в формате 5000 (Пять тысяч) рублей 05 копеек
'можно написать без скобок, без слова рубли и копейки, без самого числа цифрами
'Пятьдесят тысяч четыре                     =RUR2TEXT(n, FALSE, FALSE, FALSE)
'(Пятьдесят тысяч три) рубля 00 копеек      =RUR2TEXT(n, TRUE, TRUE, FALSE)
'50002 (Пятьдесят тысяч два)                =RUR2TEXT(n, TRUE, FALSE)
'50001 Пятьдесят тысяч один рубль 00 копеек =RUR2TEXT(n, FALSE)
'(число на распознавание, скобки, слово рублей и копеек, писать ли впереди цифрами само число)
Function RUR2TEXT(n As Variant, Optional ByVal skobki As Boolean = True, Optional ByVal withRUR = True, Optional ByVal withcifers = True) As String
 Dim cifers_txt As String 'это переменная содержащая само число прописью, именно текст, без скобок или еще чего
 Dim Nums1, Nums2, Nums3, Nums4 As Variant
 Dim s_predfinal As String 'просто тестовая строка, которую будем немного форматировать
  
  
 Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", _
                        "восемьдесят ", "девяносто ")
 Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", _
                        "восемьсот ", "девятьсот ")
 Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", _
                        "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
  
 If IsNull(n) Then n = 0 'если по какой то причине прислали нулл, то просто нулим
 minusflag = n < 0
 n = Abs(n)     'делаем модуль
 n = Round(n, 2) 'округляем до разумного - копеек


 If n >= 0 And n < 1 Then 'на случай ноль рублей
      ed_txt = "Ноль"
     GoTo final
End If
  
 'разделяем число на разряды, используя вспомогательную функцию Class
 ed = Class(n, 1)
 dec = Class(n, 2)
 sot = Class(n, 3)
 tys = Class(n, 4)
 dectys = Class(n, 5)
 sottys = Class(n, 6)
 mil = Class(n, 7)
 decmil = Class(n, 8)
 sotmil = Class(n, 9)
 

 sotmil_txt = Nums3(sotmil) 'проверяем сотни миллионов
 
 'проверяем десятки  миллионов
 Select Case decmil
   Case 1
     mil_txt = mil_txt & Nums5(mil) & "миллионов "
     GoTo www
   Case 2 To 9
     decmil_txt = Nums2(decmil)
 End Select
  
 Select Case mil
   Case 0
     If decmil > 0 Then mil_txt = Nums4(mil) & "миллионов "
   Case 1
     mil_txt = Nums1(mil) & "миллион "
   Case 2, 3, 4
     mil_txt = Nums1(mil) & "миллиона "
   Case 5 To 20
     mil_txt = Nums1(mil) & "миллионов "
 End Select
 
 If decmil = 0 And mil = 0 And sotmil <> 0 Then sotmil_txt = sotmil_txt & "миллионов"
 
www:
 sottys_txt = Nums3(sottys) 'сотни тысяч
 'проверяем тысячи
 Select Case dectys
   Case 1
     tys_txt = Nums5(tys) & "тысяч "
     GoTo eee
   Case 2 To 9
     dectys_txt = Nums2(dectys)
 End Select
 Select Case tys
   Case 0
     If dectys > 0 Then tys_txt = Nums4(tys) & "тысяч "
   Case 1
     tys_txt = Nums4(tys) & "тысяча "
   Case 2, 3, 4
     tys_txt = Nums4(tys) & "тысячи "
   Case 5 To 9
     tys_txt = Nums4(tys) & "тысяч "
 End Select
 If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " тысяч "
eee:
 sot_txt = Nums3(sot)
 'проверяем десятки
 Select Case dec
   Case 1
     ed_txt = Nums5(ed)
     GoTo rrr
   Case 2 To 9
     dec_txt = Nums2(dec)
 End Select
  
 ed_txt = Nums1(ed)
 
rrr:
 
 'формируем итоговую строку
 
final:
'если нам надлежит присобачивать туда рубли и копейки
If withRUR Then
     'далее речь о копейках (нелогично да, потом о рублях поговорим)
     Dim kop_str As String, kop_int, kop_ed, kop_dec As Integer 'надо правильно создать копейки
     kop_int = (Round((n - Fix(n)) * 100))
     kop_ed = Class(kop_int, 1)
     kop_dec = Class(kop_int, 2)
      
     kop_str = CStr(kop_int) 'тут особо не требуется словесных наименований цифр, копейки пишем просто числом
     If kop_int < 10 Then kop_str = "0" & kop_str  'если меньше 10 копеек то надо добавить нолик
     
     Select Case kop_dec 'проверяем десятки копеек
        Case 1
            kop_str = kop_str & " копеек" 'от 10 до 19 все числа идут с окончаниеем копеек
        Case Else                         'а в диапазоне 0-9 и 20-99 применимо правило последней цифры
            Select Case kop_ed
               Case 0                      'ноль копеек, двадцать копеек, тридцать копеек
                 kop_str = kop_str & " копеек"
               Case 1                      'одна копейка
                 kop_str = kop_str & " копейка"
               Case 2, 3, 4                'две три и четыре копейки
                 kop_str = kop_str & " копейки"
               Case 5 To 9                 '5, 6 , 9 копеек
                 kop_str = kop_str & " копеек"
             End Select
     End Select
      
     'теперь о рублях
     Dim rur_str As String
     Select Case dec 'проверяем десятки рублей
        Case 1
            rur_str = rur_str & "рублей" 'от 10 до 19 все числа идут с окончаниеем рублей
        Case Else                         'а в диапазоне 0-9 и 20-99 применимо правило последней цифры
            Select Case ed                'кейсуем последнюю цифру единиц чтобы определиться с окончанием
             
               Case 0                      'ноль копеек, двадцать копеек, тридцать копеек
                 rur_str = rur_str & "рублей"
               Case 1                      'одна копейка
                 rur_str = rur_str & "рубль"
               Case 2, 3, 4                'две три и четыре копейки
                 rur_str = rur_str & "рубля"
               Case 5 To 9                 '5, 6 , 9 копеек
                 rur_str = rur_str & "рублей"
             End Select
     End Select
Else
    rur_str = ""
    kop_str = ""
End If 'если надлежит присобачивать рубли и копейки закончилось
 
 'а теперь по условиям набираем предфинальную строку
  
 If minusflag Then cifers_txt = "Минус "
 cifers_txt = cifers_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
 cifers_txt = Replace(cifers_txt, Left(cifers_txt, 1), UCase(Left(cifers_txt, 1)), 1, 1) 'поднимаем регистр первого символа для красоты написания
 cifers_txt = Trim(cifers_txt) 'чистим краевые пробелы
 
 If minusflag Then n = -n 'не забываем вернуть числу минус, который мы отбирали у него ради вычислений
 If withcifers Then s_predfinal = s_predfinal & CStr(Fix(n)) 'если нужно печатать в ее начале сами цифры
  
 If skobki Then
   s_predfinal = s_predfinal & " (" & cifers_txt & ")" 'если нам нужны скобки
 Else
   s_predfinal = s_predfinal & " " & cifers_txt
 End If
  
  
 If withRUR Then s_predfinal = s_predfinal & " " & rur_str & " " & kop_str 'если нам нужны обозначения рубля и копеек
 
 s_predfinal = Replace(s_predfinal, "  ", " ") 'удаляем двойные пробелы
 s_predfinal = Trim(s_predfinal) 'удаляем краевые пробелы
 s_predfinal = Replace(s_predfinal, " )", ")") 'убираем пробел перед второй скобкой
   
 RUR2TEXT = s_predfinal
End Function
  
'вспомогательная функция для выделения из числа разрядов
Private Function Class(M, I)
  Class = Int(Int(M - (10 ^ I) * Int(M / (10 ^ I))) / 10 ^ (I - 1))
End Function


Изменено: wirstein - 31.05.2017 00:14:00
Страницы: 1
Наверх