Новости:

Форум на данный момент в стадии обновления. Если у Вас возникли проблемы со входом в свою учетную запись - просьба писать на email: info@excel-vba.ru

Главное меню

Просмотр сообщений

В этом разделе можно просмотреть все сообщения, сделанные этим пользователем.

Просмотр сообщений

Темы - McConst

#1
Дмитрий, здравствуйте.
Кажется с новым оформлением сайта есть баги. Я не нашел личного кабинета и возможность оставить обратную связь, поэтому решил создать новую тему. Удалите её.

1. Я хотел подредактировать своё сообщение, которое находится ниже данного поста. Нет кнопки редактировать, хотя к моему сообщению нет ни одного ответа. Новый сайт не видит меня как автора предыдущего сообщения? (Данное сообщение редактировать получается) Скрин с отсутствие кнопки прилагаю.


2. Я решил проверить под каким логином меня видит система или найти хоть какой-то личный кабинет. Это сделать невозможно. Интерфейс не отображает данной информации и гиперссылок на личный кабинет. Скрин прилагаю.


3. Скрины, прикреплённые к сообщение невозможно увеличить. Текст на скринах нечитаем.
4. Из-за отсутствия личного кабинета непонятно как связаться с администратором сервиса.
#2
Добрый день.
Есть ресурс kdb-gw.prod.kitco.com к которому я хочу сделать POST запрос  для получения биржевой цены на родий.
Код для скачивания такой


Public Function get_Rh_fromKITCO() As String
'Подгрузка с kitco.com данных о ценах на Rh

Dim http As Object 'Объект для выполнения запроса через XMLHttpRequest
Dim body As String '
Dim URL As String 'Адрес сервера, к которому осуществляется запрос
Dim textResponse As String 'Ответ сервера в текстовом виде
Dim RegExp As Object 'Объект для работы с регулярными выражениями при парсинге страницы
Dim resultRegExp As Object 'Результат работы регулярного выражения
Dim bid As Double, ask As Double


URL = "https://kdb-gw.prod.kitco.com"
Set http = CreateObject("MSXML2.XMLHTTP")

body = "{""query"":""fragment MetalFragment on Metal { ID symbol currency name results { ...MetalQuoteFragment } } " & _
     "fragment MetalQuoteFragment on Quote { ID ask bid change changePercentage close high low mid open originalTime timestamp unit } " & _
     "query MetalQuote( $symbol: String! $currency: String! $timestamp: Int ) " & _
     "{ GetMetalQuoteV3( symbol: $symbol currency: $currency timestamp: $timestamp ) " & _
     "{ ...MetalFragment } }"",""variables"":{""symbol"":""RH"",""currency"":""USD"",""timestamp"":1718003520},""operationName"":""MetalQuote""}"


http.Open "POST", URL, False 'False - синхронное соединение

On Error GoTo ext:
http.Send (body)

textResponse = http.responseText

Set RegExp = CreateObject("VBScript.RegExp") 'Создаём объект для работы с регулярными выражениями
RegExp.Global = False 'Ищем первое совпадение

RegExp.Pattern = """bid\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
bid = resultRegExp(0).SubMatches(0)

RegExp.Pattern = """ask\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
ask = resultRegExp(0).SubMatches(0)


get_Rh_fromKITCO = WorksheetFunction.Min(bid, ask)



Exit Function
ext:
    'Выход из функции по ошибки
    get_Rh_fromKITCO = Err.Description
End Function



Код возвращает ошибку: "Ошибка скачивания указанного ресурса".

Изучение информации о ресурсе показало, что сервис работает по протоколу TLS 1.3
Ошибка работы протоколов при запросах достаточно распространённая. Объект MSXML2.XMLHTTP настраивается в "Свойствах обозревателя" Internet Explorer включением соответствующих галок сертификатов безопасности.
К сожалению у меня операционка windows 7 и TLS 1.3 невозможно включить, так как он отсутствует в опциях.

И да, IE 11  не хочет открывать https://kdb-gw.prod.kitco.com/ из браузерной строки, хотя Chrome и даже Microsoft Edge нормально открывают этот ресурс.
Замена MSXML2.XMLHTTP на WinHttp.WinHttpRequest.5.1 ничего не даёт. Та же ошибка, сформулированная по другому: "Ошибка поддержки безопасных каналов"

1. Существуют ли способы для парсинга страниц на VBA подключать не библиотеки Internet Explorer, а хотя бы COM-объекты Microsoft Edge (если есть такие)?
Вариант с Selenium возможен, но трудоёмок при портировании книги Excel на другие машины. Нужно искать и инсталлить совместимые версии библиотек.

2. Может можно поставить какие-то патчи или сертификаты на Win7, чтобы TLS 1.3 заработал? Другие же браузеры работают нормально с этим ресурсом.

В последнее время проблем с TLS 1.3 встречается всё чаще. Например, Telegram API работает по этому протоколу и из VBA невозможно без танцев с бубном отправить в телеграм-бот сообщение.

Я для себя нашел кривое решение. На своём удалённом хосте написал php-скрипт

<?php
//Серверный модуль для обхода ограничений кросс-доменных запросов


$html "incorrect request";

header('Access-Control-Allow-Origin: *');
header('Access-Control-Allow-Credentials: true');
header('Access-Control-Allow-Headers: X-Requested-With');
header('Content-type: text/html; charset=utf-8');


//Получен запрос на чтение HTML по адресу url
$url 'https://kdb-gw.prod.kitco.com';

$body='{"query":"fragment MetalFragment on Metal { ID symbol currency name results { ...MetalQuoteFragment } } fragment MetalQuoteFragment on Quote { ID ask bid change changePercentage close high low mid open originalTime timestamp unit } query MetalQuote( $symbol: String! $currency: String! $timestamp: Int ) { GetMetalQuoteV3( symbol: $symbol currency: $currency timestamp: $timestamp ) { ...MetalFragment } }","variables":{"symbol":"RH","currency":"USD","timestamp":'.time().'},"operationName":"MetalQuote"}';

$ch curl_init($url);
curl_setopt($chCURLOPT_HTTPHEADER, array('Content-Type:application/json'));
curl_setopt($chCURLOPT_POST1);
curl_setopt($chCURLOPT_POSTFIELDS$body); 
curl_setopt($chCURLOPT_RETURNTRANSFERtrue);
curl_setopt($chCURLOPT_SSL_VERIFYPEERfalse);
curl_setopt($chCURLOPT_HEADERfalse);
$res curl_exec($ch);
curl_close($ch);
 
$res json_encode($resJSON_UNESCAPED_UNICODE);
print_r($res);


и делаю запрос из VBA к https://glpa.catalyst.by/stat/php/vpn-kitco-rh.php , который данные возвращает в читаемом для Internet Explorer виде.

Public Function get_Rh_fromKITCO2() As String
'Подгрузка с kitco.com данных о ценах на Rh
'Возврат через глобальную коллекцию currencies
Dim http As Object 'Объект для выполнения запроса через XMLHttpRequest

Dim URL As String 'Адрес сервера, к которому осуществляется запрос
Dim textResponse As String 'Ответ сервера в текстовом виде
Dim RegExp As Object 'Объект для работы с регулярными выражениями при парсинге страницы
Dim resultRegExp As Object 'Результат работы регулярного выражения
Dim bid As Double, ask As Double


URL = "https://glpa.catalyst.by/stat/php/vpn-kitco-rh.php"
Set http = CreateObject("MSXML2.XMLHTTP")

http.Open "GET", URL, False 'False - синхронное соединение
http.setRequestHeader "Content-Type", "application/json; charset=utf-8"

On Error GoTo ext:
http.Send

textResponse = http.responseText

Set RegExp = CreateObject("VBScript.RegExp") 'Создаём объект для работы с регулярными выражениями
RegExp.Global = False 'Ищем первое совпадение

RegExp.Pattern = """bid\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
bid = resultRegExp(0).SubMatches(0)

RegExp.Pattern = """ask\\""\:(\d+\.?\d*)" 'Шаблон для поиска цены предложения. Парсер сайта заменяет двоеточие и открывающую скобку на грустный смайлик.
Set resultRegExp = RegExp.Execute(textResponse)
ask = resultRegExp(0).SubMatches(0)


get_Rh_fromKITCO = WorksheetFunction.Min(bid, ask)



Exit Function
ext:
    'Выход из функции по ошибке
    get_Rh_fromKITCO = err.Description
End Function


Есть ли более оптимальные решения описанной проблемы?
#3
Здравствуйте.
Есть ли у VBA Excel какой-нибудь удобный инструмент для работы с Git ?
Пока в лоб вижу варианты: экспорт в проекта в файл каждый модуль по отдельности. В терминале коммитить и пушить на удалённый сервер. Или обратное действие: модули качаются с удалённого сервера, импортируются вручную каждый отдельно и потом только работа с ними.
Крайне неудобно.

[admin]Название темы должно быть максимально информативным, таким, чтобы уже из названия темы другим пользователям была приблизительно понятна Ваша проблема п.п. 4.2. и 4.14. Правил форума Сейчас название изменил я - в следующий раз просто удалю[/admin]
#4
Добрый день.
У меня код на VB6 открывает книгу Excel и вызывает в ней серию макросов

Public Sub RecalculateDB()
'Пересчёт цен в базе данных
Dim excel As Object
Dim wb As Object 'Книга Excel

On Error GoTo Recalc_exit
Set excel = CreateObject("Excel.Application")
excel.Visible = True
Set wb = excel.Workbooks.Open(filename:=ExcelDBApp, ReadOnly:=True)
excel.run (wb.name & "!RecalculatePrice") 'Пересчёт локальной базы данных
excel.run (wb.name & "!CreateReserveDB") 'Создание резервной копии пересчитанных данных
excel.run (wb.name & "!UploadCalcFile") 'Переносим файл калькуляции на интернет-сервер

'Сразу после пересчета закидываем обновленнные данные по базе в интернет. True - отправить уведомление в телеграм,
'False - не отображать MsgBox об успешности операции обновления данных в интернете
excel.run wb.name & "!CreateSafetySQLScript", True, False

wb.Close
excel.quit
Exit Sub
Recalc_exit:
'Ошибка пересчёта базы данных
    If Len(AdminTelegramID) > 0 Then
        SendTelegramMessage "Ошибка при пересчёте и обновлении базы данных \n \n" & Err.Description, _
            AdminTelegramID
    End If
End Sub


Иногда на стороне макросов появляются ошибки, связанные с работой сети. Если обработать ошибку в процедуре VBA, то внешнее приложение её не замечает. Если не обрабатывать, то код зависает вместе с выводом Alerta: Debug / End и ждёт действий пользователя. При этом код висит.
Как корректно обработать ошибку в процедуре VBA и вернуть её внешнему приложению, чтобы внешнее приложение приняло сообщение об ошибке и корректно закрыло книгу?
#5
Добрый день.
Заинтересовался библиотеками для VBA, которые поддерживают работу с регулярными выражениями.
Гугл предлагает в основном библиотеку от Microsoft Internet Explorer 5.5
Как по мне, то для 2024-го года библиотека старовата. Хотя на безрыбье и это хлеб.
Может кто-нибудь знает более свежие библиотеки, которые можно подключить к VBA-проекту? Например какие-нибудь си-шные надстройки или т.п.?
#6
Добрый день.
Я могу поместить диапазон range  в виде картинки в буфер обмена следующим кодом

Public Sub ScrnToGif()
'Сохраняем скриншот в виде gif файла
Dim lastrow As Long
Dim ws As Worksheet, rng As Range

Set ws = Worksheets(1)
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).row + 3
Set rng = Range(ws.Cells(1,1), ws.Cells(lastrow, 10))
rng.CopyPicture

End Sub


А как теперь сохранить картинку, которая находится в буфере сразу в файл, например gif или png? Не могу найти, наверняка есть какой-нибудь ActiveX метод
#7
Здравствуйте.
Я в своём проекте использую сторонние книги Excel, которые открываю в самостоятельном процессе таким кодом:

Set app = CreateObject("Excel.Application")
app.Visible = False
Set PriceWB = app.Workbooks.Open(FileName:=FilePath & CalcFile, ReadOnly:=True)


Время от времени в проекте возможны аварийные остановки и невидимые процессы остаются висеть в памяти. Обычно я их удаляю через диспетчер задач.
Можно ли как-то перебрать висящие в памяти процессы Excel, прочитать имена книг, которые в них открыты и позакрывать их макросом или переподключиться к нему по новой?
#8
Добрый день.
Нужно из VBA выполнить https запрос к сайту
https://www.nbrb.by/api/exrates/rates/145?ondate=2020-11-16

Стандартное решение, которое работало через http для объекта MSXML2.XMLHTTP не работает. Request возвращает status=12157, ошибку сертификата и пустой ResponseText

Видел в интернете разные извращения с другими объектами, но конкретно как работать с сертификатами так и не разобрался.
Одна из вариаций кода, которая тоже не работает.

Public Function NBRBCourse2(MyDate As Date) As Single
'Пользовательская функция, возвращает курс выбранной валюты на указанный день
'Коды ошибок:
' -1    такой валюты за такую дату не найдено
' -2    сайт Нацбанка загрузился с ошибкой

Dim http As Object 'Объект для выполнения запроса через XMLHttpRequest
Dim text As Variant 'Получаемый текст со страницы
Dim Pos As Long, lngth As Long 'Позиция в тексте при парсинге
Dim url As String
Dim res

url = "https://www.nbrb.by/api/exrates/rates/145?ondate=" & Format(MyDate, "YYYY-MM-DD")

Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

http.Open "GET", url, False 'False - синхронное соединение
http.SetClientCertificate ("LOCAL_MACHINE\Personal\My Certificate")

On Error Resume Next
res = http.Send


If http.Status <> 200 Then
'Ответ на запрос получен с ошибкой
   NBRBCourse2 = -2
End If
text = http.ResponseText

Pos = InStrRev(text, ":") + 1
If Pos = 0 Then
   NBRBCourse2 = -1 'Валюта не найдена
   Exit Function
End If

lngth = Len(text) - Pos
If lngth < 1 Then
   NBRBCourse2 = -1 'Валюта не найдена
   Exit Function
End If

NBRBCourse2 = CDbl(Replace(Mid(text, Pos, lngth), ".", ","))

End Function


Помогите сделать работающий запрос, чтобы сайт возвращал не пустое значение.
#9
У меня есть пользовательская функция, в которую в качестве аргумента поступает ссылка на ячейку.
Public Function Formula(X As Range) As String
Так же имеется ссылка вида R1C1 в текстовом виде, указывающая на ячейку относительно объекта X.
Что-то вроде

Dim Ref as string
Ref="ПользовательскийЛист!R[-1]C"

Мне нужно получить с помощью ссылки R1C1 текст в ячейке, на которую указывает данная ссылка.
По аналогии со стилем ссылок A1 просится такая запись

Set NewRng=X.Range(Ref)

Но компилятор на такую запись ругается. Как получить доступ к новой ячейке?
#10
Добрый день.
Пользуюсь Excel 2003 на Win 10. Предпочитаю старый офис в силу быстродействия при обработке таблиц с большим объемом данных порядка 30-60 тыс. строк. Новые офисы на таком объеме просто виснут.
Проблема следующая. Чтобы иметь возможность независимой параллельной работы VBA в нескольких книгах одновременно, нужно чтобы каждая книга открывалась в отдельном процессе Excel.
В голове помню, что нужно запретить dde и поставить параметр "%1" при запуске Excel.
В Win XP это делалось элементарно в проводнике при выборе приложения по умолчанию, в Win10 нужно править реестр. Постоянно забываю в каких ветках реестра нужно копаться. Просьба, напишите кто помнит, что именно нужно править?

Можно ли параметр "%1" править не для всего реестра, а для конкретных файлов с макросами, например в ярлыках на файлы?  - так было бы наверное корректнее.
#11
Добрый день.
Написал скрипт для копирования данных из таблицы Access в таблицу MySQL. Структура таблиц и там и там одинакова. Сначала я всю таблицу Access переношу в массив типа Variant, из которого построчно беру данные и заполняю c помощью метода CopyRecord записи в MySQL. Сам CopyRecord просто создает Adodb.Command, которая вызывает хранимую процедуру SetRecord из MySQL и передаёт туда поля в виде параметров. В целом код рабочий и выглядит вот так


Public Sub CopyRecord(AccessArrayRecordNum As Long, AccessArrayTable As Variant)
'Заполнить строку в базе данных входящими параметрами
'AccessArrayTable - таблица данных из Access
'AccessArrayRecordNum - порядковый номер строки из базы данных Access, для которого выполнется запись в MySQL

Dim Command As Object

Set Command = CreateObject("ADODB.Command")
Set Command.ActiveConnection = Conn
Command.CommandType = 4 'Процедура
Command.NamedParameters = False 'Параметры поименованные
Command.commandtext = "SetRecord" 'Хранимая процедура на добавление или обновление записи в таблицу

Command.Parameters.Append Command.CreateParameter("varID", 19, 1) 'Создаем параметр adUnsignedInt(19), 1-входной
With Command.Parameters("varID")
   .Value = AccessArrayTable(0, AccessArrayRecordNum)
End With

Command.Parameters.Append Command.CreateParameter("varPayment", 17, 1) 'Создаем параметр adUnsignedTinyInt(17), 1-входной
With Command.Parameters("varPayment")
   .Value = CByte(AccessArrayTable(1, AccessArrayRecordNum))
End With

Command.Parameters.Append Command.CreateParameter("varAnalyse_Date", 133, 1) 'Создаем параметр adDBDate(133), 1-входной
With Command.Parameters("varAnalyse_Date")
   .Value = AccessArrayTable(2, AccessArrayRecordNum)
End With

Command.Parameters.Append Command.CreateParameter("varNotes", 129, 1, 254) 'Создаем параметр adChar(129), 1-входной
With Command.Parameters("varNotes")
   If IsNull(AccessArrayTable(21, AccessArrayRecordNum)) Then
       .Value = ""
   Else
       .Value = AccessArrayTable(21, AccessArrayRecordNum)
   End If
End With

Command.Execute
Set Command = Nothing

End Sub

Приведенная процедура является методом моего класса для работы с базой данных. В самом начале для соединения с MySQL используется объект Conn, который инициализируется в методе OperDB:

Public Sub OpenDB()
'Открыть соединение с базой данных на сайте
'Для успешной работы объекта предварительно требуется инсталляция ODBC MySQL Connector Driver
'Драйвер скачивается https://dev.mysql.com/downloads/connector/odbc/
'Для офиса 2003 разрядность драйвера 32bit не зависимо от разрядности Windows
'Правильное название драйвера при проиписывании строки-коннекта можно
'найти после инсталляции в ветке реестра
'HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers\

Dim ConnString ' Строка для коннекта
Dim Driver As String

Driver = "DRIVER={MySQL ODBC 8.0 Unicode Driver}" 'Драйвер для коннекта. Имя/версию драйвера приписать в фигурных скобках
Set Conn = CreateObject("ADODB.Connection")

ConnString = Driver & ";" & _
   "SERVER=" & ServerDB & ";" & _
   "PORT=" & PortDB & ";" & _
   "DATABASE=" & NameDB & ";" & _
   "UID=" & UserDB & ";" & _
   "PWD=" & PasswordDB & ";"
Conn.ConnectionTimeout = 5  'Время до обрыва ожидания соединения
Conn.Open ConnString

End Sub


Это всё предыстория. Подобным кодом, только с другой строкой для коннекта я базу данных Access заполнял без проблем. А вот с заполнением MySQL выскочила неожиданная проблема. При заполнении полей MySQL типа char обрезаются концевые пробелы в тексте.
Например, я передаю в качестве параметра в объект ADODB переменную со строкой такого вида "МОЙ ТЕКСТ  ". А в базе MySQL он появляется в таком виде "МОЙ ТЕКСТ".
Если в параметр ADODB попадает строка с точкой в середине, то все данные начиная от точки и далее обрезаются и в поле базы данных не поступают. Например:
"3257, Serials ...938AA and ...936AA are same catalysts." обрезается и в MySQL остается вот это - "3257, Serials"
Тех.поддержка сказала, что проблема скорее всего в наличие кавычек вокруг текста. По факту это так и оказалось. Если код в методе CopyRecord видоизменить таким образом:

Command.Parameters.Append Command.CreateParameter("varNotes", 129, 1, 254) 'Создаем параметр adChar(129), 1-входной
With Command.Parameters("varNotes")
   If IsNull(AccessArrayTable(21, AccessArrayRecordNum)) Then
       .Value = ""
   Else
       .Value = Chr(34) & AccessArrayTable(21, AccessArrayRecordNum) & Chr(34)
   End If
End With


тогда текст не усекается, передается полностью, но он в поле базы данных так и выглядит закавыченым. Полагаю, что проблема в особенности работы драйверов ODBC для MySQL, так как при экспорте данных в Access таких приколов с данными у меня не было. Кто-нибудь знает как извернуться, чтобы нормально передать текст в MySQL?
#12
Здравствуйте.
Требуется прочитать текст из Combobox стороннего приложения через WinAPI.
На данный момент получается только получить индекс выбранного текста из списка командой

index = SendMessage(hwnd, CB_GETCURSEL, ByVal CLng(0), ByVal CLng(0))

Все остальные команды дают кракозябы. Даже длина текста определяется неправильно.
'TextLength = GetWindowTextLengthW(hwnd)
'TextLength = SendMessageW(hwnd, CB_GETLBTEXTLEN, ByVal index, ByVal 0)

Spy++ тоже неправильно читает комбо-бокс.

https://ibb.co/gdWZ0wh

Собственно, как прочитать текст (активный или по индексу) в комбо-бокс. Возможно дело в кодировке ANSI/UTF
но изменение декларации так же не помогает:

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#13
Здравствуйте.
Макрос взаимодействует с другими приложениями, после чего требуется, чтобы окно Excel стало активным (по верх всех окон). После танца с бубном и поиском в гугле пришел только к такому коду


Public Sub GetPCR()
'Получение результатов расчета по PCR (расчеты процедурой CalculatePCR)
'и перенос результата расчета в строку журнала анализов
Dim Y() As Double 'Переменная для получения результатов расчета

'CalculatePCR Y
'Buffer PCA:=True, Y:=Y 'Передаем данные в журнал анализов
SetForegroundWindow Application.hWnd
Application.WindowState = xlMinimized
Application.WindowState = xlMaximized
ShowWindow Application.hWnd, SW_SHOW
End Sub

При этом код не работает как надо. То есть я вижу, что окно Excel быстро-быстро моргает из-под другого приложения (например из VBA редактора, в котором я запускаю код по F5) - видимо на долю секунды Excel всё же становится активным, а затем вновь фокус передается в тот же редактор VBA или на окно приложения, вызванного из заремарченной процедуры. Не пойму в чем дело. Это сам Excel как-то неправильно работает. Стороннее приложение, с которым я работаю, по ShowWindow отлично обрабатывает команду и активируется.
#14
Здравствуйте.
Имеется большая матрица коэффициентов типа double в двумерном динамическом массиве. Хочу сохранить матрицу в файл. Числа типа double в текстовом виде хранить нерационально, тем более что double памяти занимает всего 8 байт. Есть ли на VBA возможность сохранить массив double в файл? На C++ для этого есть библиотечная функция fwrite. Возможно VBA сделает то же самое через Win API? Думаю, что через цикл for и чтение памяти для каждого элемента массива я наверное сделал бы и сам, но этот способ медленный. В связи с этим ещё будет обратная задача. Этот массив потребуется восстанавливать обратно из файла в область памяти массива.
Подскажите рациональное решение.
#15
Не с того ни с сего перестали выполняться директивы #if... #else... #then
Блок просто пропускается. Принудительное выполнение в пошаговом режиме отладки перемещением на команду маркера тоже не получается, маркер не хочет выставляться. Грешу на касперского, который просил обновиться с перезагрузкой.
Офис 2003. В блоке классическая проверка на vba7
#16
Написал макрос, который через запрос Access должен заносить в таблицу с текстовым полем строковое выражение из ячеек Excel. В общем случае для численно-буквенных выражений макрос работает,  но когда в выражении появляется знак косой черты "/", выбивается ошибка: "Приложение использует для текущей записи значение неверного типа".
Предполагаю, что косая черта при работе с SQL-запросами относится к каким-то запрещенным для использования знакам. Сам по себе ввод этого символа при ручном заполнении таблицы никаких ошибок не вызывает. Т.е. теоретически обойти ограничение на передачу текстовой строки с косой чертой возможно. Подскажите кто с этим сталкивался и как с этим справиться?


Можно пойти более хитрым путем, заносить вместо косой черты какой-нибудь символ типа знака подчеркивания, а при чтении таблицы Access средствами VBA вновь знак подчеркивания менять на косую черту, но мне бы хотелось иметь полное соответствие c исходником в Excel

Извиняюсь. Нашел у себя ошибку. При передачи данных выставил ограничение на текстовую строку 10 байт вместо 150. Просьба модератора удалить тему.
#17
Здравствуйте
Пытаюсь передать параметр @Size на VBA в запрос Access. Параметр в Access соответсвует типу: "Действительное, фиксированное, точность 2, шкала 1, число десятичных знаков 1".


Dim Size as Double
Dim TempParam as Variant

'Дальше идет кусок кода где в частности присваивается Size=1,9

   If Size = 0 Then
       TempParam = Null
   Else
       TempParam = Size
   End If
   Command2.Parameters.Append Command2.CreateParameter("@Size", 131, 1, 2) 'Создаем параметр  c фиксир. точностью, 2 байта
   With Command2.Parameters("@Size")
       .NumericScale = 1 '1 знак после запятой
       .Precision = 2 'Точность - два знака (1 до точки и 1 после точки)
       .Value = TempParam
   End With
   
   Command2.Execute 'Выполняем запрос, который должен занести Size в поле таблицы Access c фиксир. точкой



Команда Execute выдает ошибку "Несоответствие типов данных в выражении условии отбора"
Долго перебирал типы, искал  в Гугле, наконец сдался. Может кто поможет, как задать правильно параметр на VBA
Прикрепил файлы Access и Excel в архиве.
В модуле Excel DBWork процедура Main - создает соединение с базой данных и пытается сделать запись в таблицу через запрос Access. Проблема именно в типе переменной @Size, так как запрос без этой переменной работает корректно.
#18
Здравствуйте.
Прикрепил к одной из машин свою пользовательскую надстройку. Работает вроде бы нормально, но когда закрываю Excel, он долго тормозит, наверное что-то сохраняет.  Я на закрытие файлов никаких событий не создавал. Просмотрел все книги через диспетчер проектов VBA, никаких событий BeforeSave нет. Как можно отследить что делает книга перед закрытием, куда идут ресурсы процессора? На других машинах, на которых стоит эта же надстройка, такого подтормаживания не наблюдается. Всё закрывается быстро.
#19
Здравствуйте.
На работе поставили новый комп с Win 7 x64. Все макросы писались на офисе 2003. Под новую машину на Win x64 пытался ставить 2013 офис, но в файлах с большим количеством объектов (CheckBox, Buttons порядка 4000 тыс. штук) офис тормозит так, что невозможно работать. Вернулся к офису 2003, всё вновь летает и даже быстрее чем на WinXP, но есть проблема. Имеются макросы, которые взаимодействуют с ПО стороннего разработчика, пытаюсь управлять спектрометром из Excel. Для этого в частности используются API типа SendMessage. В XP все работало хорошо, но на Win64 появились проблемы, SendMessage периодически возвращает ерунду, так как параметры VB6 передает и получает через 32 разряда. Как вариант адаптации своих макросов  в 2003 офисе к новой винде вижу в создании своих dll на др. языке (например MASM), которые вызывают API и возвращают результаты в формате понятном VB6. Может кто-нибудь знает более удобное решение этой проблемы? На каком-то форуме видел вариант решения в определении собственного типа LongLong как два последовательных значения Long. Но это будет работать только если параметр передается как byRef, а SendMessage половину команд обрабатывает через byVal.
#20
Здравствуйте.
Поставили на работе 64 разрядную винду. Так как макросы активно работают с API, офис 2003 типы LongLong не понимает, пришлось ставить офис 2013. Сисадмин поставил 32-разрядный. Тормозит ужасно. В книгах Excel много объектов (чекбоксы и кнопки для каждой позиции). Порядка 4000 штук. 2003-й с ними справлялся, а в 2013-м работать невозможно. Можно ли ускорить работуExcel? Добавил планку на 4Гб к уже имевшимся 4Гб, не помогло. Как вариант, снести х32 и поставить х64. Но нет уверенности что поможет.
Что ещё можно сделать, чтобы ускорить работу с книгой?  Может в настройках покопаться. Худший выход для получения максимальной производительности, это поставить 2003-й и все функции, где используются API с х64 передачей данных переписать в dll на ассемблере.
Яндекс.Метрика Рейтинг@Mail.ru