Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 След.
Как разорвать связь соединения, если она не разрывается?
 
Доброго времени суток.
В приложенных файлах есть книга, в которое есть неведомое соединение, которое не удается разорвать, отключить, удалить.
Будьте добры, пожалуйста, помогите избавиться от этого соединения.
С чем такое может быть связано?
Спасибо!
Улыбнись.
VBA. Заменить текст во ВСЕХ ячейках КНИГИ (включая скрытые листы) текстовое значение на формулу.
 
Доброго времени суток, уважаемые люди!

Подскажите, пожалуйста, код, которым возможно осуществить операцию по замене ТЕКСТА, скажем, например «Информация» на ФОРМУЛУ «=2+2*2».
Операция необходимо совершить на всех листах книги ( включая скрытые ) во всех ячейках, содержание которых совпадает с искомым текстом ПОЛНОСТЬЮ. Регистр - неважен.
Спасибо!

upd:
Макрорекодер сообщаеТ следующее:
Код
    Cells.Replace What:="Информация за указанный период", Replacement:= _
        "=""Расход топлива за "" &  ТЕКСТ(ДАТАМЕС(0;$L$7);""ММММ"") & ""   "" & $L$9 & "" г.""" _
        , LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False

При повторном запуске, код не осуществляет никаких действий.
Изменено: falmrom - 30 Авг 2019 01:06:56
Улыбнись.
VBA. Проверить наличие в ДРУГОЙ КНИГЕ модуля с именем «Module1» и, если его нет - СОЗДАТЬ
 
Доброго времени суток!
Необходимо обработать n-ое кол-во книг и проверить каждую на предмет наличия модуля с именем «Module1» и,
если он есть - удалить в нем все строки,
если его нет - создать пустой модуль с именем «Module1»

Часть кода у меня написана. Необходимо составить ту часть, которая проверяет, чистит или создает новый модуль «Module1»

Спасибо!
Улыбнись.
Формула. Как определить наименьшую дату в таблице, которая помимо дат содержит еще и пустые строки? (игнорировать пустые строки)
 
Доброго времени суток!
Столкнулся с простой сложностью: не могу нагуглить, разобраться и понять ( видимо, плохо делаю ) , как определить минимальную дату в таблице, важный столбец которой содержит в себе помимо значений дат, еще и пустые строки, которые необходимо игнорировать в формуле определения минимальной даты.

Прошу помощи, совета! Спасибо!
Скрин и сам файл-пример прилагаю.
Изменено: falmrom - 23 Авг 2019 08:58:24
Улыбнись.
VBA В чем причина неработоспособности кода умножения диапазона значений за счет «.value = .value * 100 »
 
Добрый день! В чем причина ошибки при выполнении макроса ?
Код
Sub qwe()
ПроцентУвеличенияЦены = 8

Range(Cells(24, 9) & ":" & Cells(60, 9)) = _
Range(Cells(24, 9) & ":" & Cells(60, 9)s) / 100 * (100 + ПроцентУвеличенияЦены)
    
End Sub

Спасибо!
Изменено: falmrom - 22 Авг 2019 20:57:22
Улыбнись.
Не суммируются значения, полученные формулой =ТЕКСТ($C$10*$D$10;"##0 000,00")
 
Доброго времени суток!
Не работать формула СУММ при подсчете сумм ячеек, которые содержат в себе «=ТЕКСТ($C$3*$D$3;"##0 000,00")» и подобное. Файл пример - в приложениях + скрин.

Какая может быть причина и как возможно это исправить?
Спасибо!
Изменено: falmrom - 22 Авг 2019 11:03:07
Улыбнись.
VBA. Словарь. Как организовать сортировку собранных ключей по алфавиту в коде
 
Доброго времени суток тем, с кем еще сегодня не приветствовали друг друга.

Будьте добры, помогите осуществить в словаре сортировку полученных ключей по алфавиту. Спасибо!
Код
Sub ВидыТопливаЛитрыСредняяЦена()
  
 Sheets("ГПН").Select
  
'===============Создаем словарь===========
Dim dic
Set dic = CreateObject("Scripting.Dictionary") 'создаем словарь

   dic.CompareMode = TextCompare ' текстовый режим - игнорирует регистр
    
For i = 2 To Cells(Rows.Count, 3).End(xlUp).row 'цикл с ДВАДЦАТОЙ строки листа до последней заполненной
    k = Range("D" & i) 'создаем ключ для словаря сцепкой ячеек. Все ключи в словаре уникальны
    it = Range("E" & i) 'значение по ключу, в примере - количество
                If dic.Exists(k) Then 'проверяем, есть ли уже такой ключ в словаре
                  dic.item(k) = dic.item(k) + it 'если есть, суммируем колличество с тем, что уже было ранее
                Else
                  dic.Add k, it 'если нет, делаем в словаре новую запись
                End If
Next

Rows("1:" & dic.Count + 7).Insert 'вставляем сверху строки

СтрокаВыгрузки = 1 'строка формирования заголовка и первая строка для выгрузки данных
[a1] = "Вид топлива": [b1] = "Кол-во л.": 'в пятой строке делаем шапку

i = СтрокаВыгрузки + 1 'с этой строки будем выгружать данные из словаря
For Each ky In dic.keys 'цикл переборки всех записанных ключей
    ar = ky 'разделяем сцепку обратно, получаем два элемента
    Range("A" & i) = ar 'записываем эти элементы в ячейки
    Range("B" & i) = dic.item(ky) 'записываем в ячейку количество
     
    i = i + 1 'переходим к следующей строке
     
    k = 1
    k = k + 1
    Range("A" & i & ",A" & i - 1).MergeCells = True
 
Next
 
dic.RemoveAll
End Sub
Улыбнись.
Подсчет суммы литров по каждому виду топлива
 
Доброго времени суток, друзья!

Будь добры, подскажите, пожалуйста, как посчитать сколько в таблице всего литров топлива каждого из видов топлива?
Реализация необходимо именно через VBA.

Файл в приложении.
Спасибо!


UPD: Необходимы порядок сортировки:

Аи-92
Аи-95
G-95
ДТ
G-Drive 100
СУГ
Изменено: falmrom - 21 Авг 2019 17:05:43
Улыбнись.
Разбор возникающей ошибки при обновлении PQ-запросов из иной книги
 
Доброго времени суток, уважаемые!
Будьте добры, светлые умы, пожалуйста, помогите разобрать ошибку, понять, в чем причина возникновения и решить проблему незавершения обновления PQ-запроса.
Спасибо!

Код
Feedback Type:
Frown (Error)

Error Message:
Исключение из HRESULT: 0x800A03EC

Stack Trace:
   в Microsoft.Mashup.Client.Excel.NativeExcelFunctionsBase.ValidateResult(Int32 result, Int32[] expectedValues)
   в Microsoft.Mashup.Client.Excel.Shim.NativeFillServices.PerformPostRefreshFixups(IWorkbook workbook, IListObject listObject, String[] columnNames, FillColumnType[] columnTypes, String[] previousColumnNames, FillColumnType[] previousColumnTypes, FillColumnType[] recordFieldTypes, Boolean removeBlankColumns, Boolean applyResultStyle)
   в Microsoft.Mashup.Client.Excel.Fill.PollingRefreshFillSession.CompleteRefresh(IWorkbook workbook, Boolean onTimer)
   в Microsoft.Mashup.Client.Excel.Fill.PollingRefreshFillSession.UpdateRefreshStatus(IWorkbook workbook, Boolean onTimer)
   в Microsoft.Mashup.Client.Excel.Fill.PollingRefreshFillSession.ResumeFill(Boolean onTimer)
   в Microsoft.Mashup.Client.Excel.PollingFillManager.<UpdateQueries>b__a(IFillSession fillSession)
   в Microsoft.Mashup.Client.UI.Shared.Model.QueriesUtilities.ForEachWithChangeScope[T](IEnumerable`1 items, Func`2 getQueries, Action`1 action)
   в Microsoft.Mashup.Client.Excel.Fill.FillManager.ForEachFillSessionByWorkbook(Action`1 action)
   в Microsoft.Mashup.Client.Excel.PollingFillManager.<OnFillUpdateTimerTick>b__6()
   в Microsoft.Mashup.Host.Document.ExceptionHandlerExtensions.HandleExceptions(IExceptionHandler exceptionHandler, Action action)

Stack Trace Message:
Исключение из HRESULT: 0x800A03EC

Invocation Stack Trace:
   в Microsoft.Mashup.Host.Document.ExceptionExtensions.GetCurrentInvocationStackTrace()
   в Microsoft.Mashup.Client.UI.Shared.FeedbackErrorInfo..ctor(String message, Exception exception, Nullable`1 stackTraceInfo)
   в Microsoft.Mashup.Client.Excel.Native.NativeUserFeedbackServices.ReportException(IWindowHandle activeWindow, IUIHost uiHost, FeedbackPackageInfo feedbackPackageInfo, Exception e, Boolean useGDICapture)
   в Microsoft.Mashup.Client.UI.Shared.UnexpectedExceptionHandler.<>c__DisplayClass1.<HandleException>b__0()
   в Microsoft.Mashup.Client.UI.Shared.UnexpectedExceptionHandler.HandleException(Exception e)
   в Microsoft.Mashup.Host.Document.ExceptionHandlerExtensions.HandleExceptions(IExceptionHandler exceptionHandler, Action action)
   в System.Windows.Forms.Timer.OnTick(EventArgs e)
   в System.Windows.Forms.Timer.TimerNativeWindow.WndProc(Message& m)
   в System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)


Supports Premium Content:
True
Улыбнись.
[ PQ ]. Вполнить условие, если ячейка содержит символ
 
Доброго времени суток, уважаемые!
Будьте добры, подскажите, пожалуйста, код добавления столбца, со следующим условиями его образования:

Если значение в [Тов] содержит в себе где-либо символ «e» , то УСЛОВИЕ1 else УСЛОВИЕ2

Весь затык с синтаксисом в метсе, где необходимо сообщить не точное значение ячейки, а лишь символ.

Мой код:
Код
each if[Дата]=""and[Тов]="**e**"then"удалить"else"")




Спасибо!
Улыбнись.
Как запретить принудительное закрытие userform до истечения определенного времени?
 
Доброго времен, уважаемые!
Есть некоторые пользователи, которые на автомате закрывают важные сообщения, которые пытается донести книга.
Как запретить принудительное закрытие msgbox до того, как истечет определенное время, чтобы пользователь волей-неволей вчитался?
Спасибо!
Улыбнись.
Как закрыть только windows(ThisWorkbook.name) при клике на Кнопку в userform?
 
Доброго времени суток! Каким образом возможно закрыть только окно текущей книги, из которой вызван макрос при клике на кнопку в userform. Куда вставлять код - известно.
Подскажите, пожалуйста, верный код закрытие ТОЛЬКО ТЕКУЩЕЙ КНИГИ. Спасибо большое!

Пробовал:
Код
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Save
    Application.Quit

НО ! 1) Появляется запрос о пересохранении 2) Закрываются ВСЕ окна excel
Улыбнись.
Как сделать возможным использование книги при активном userform ?
 
Доброго времени суток! Подскажите, пожалуйста, возможно ли совместить пользование книгами excel при активном userform ? Обычно, при отображении userform, действия с самими книгами становятся недоступными до закрытия userform.
Спасибо!
Улыбнись.
Как разместить UserForm по центру экрана при условии, что сама книга 1px*1px в левом верхнем углу ?
 
Доброго времени суток! Подскажите, пожалуйста, код для события на открытие книги, которые разместит либо саму книгу ровно в центре экрана либо userform, который открывается при открытии книги.
Спасибо!
Улыбнись.
Как сослаться на один и тот же файл изображения в разных userform's ?
 
Доброго времени суток, уважаемые люди! Подскажите, пожалуйста, каким образом возможно в разных userform'ах сослаться разными control'ами на один и тот же файл изображения, чтобы не плодить один и тот же файл  и не раздувая тем самым размер книги?
Спасибо!
Хорошего дня!
В файле-примере - два userform, каждый из которых содержит в себе по одному одинаковому pictures. Как сделать в одном userform ссылку на изображение в другом userform?
Изменено: falmrom - 25 Июл 2019 16:34:43
Улыбнись.
Комплексное обновление (изменение содержания) всех модулей n-кол-ва книг в папке через VBA из другой (ОСНОВНОЙ) книги
 
Доброго времени суток! Хорошего дня всем, кто уделяем время на прочтение топика. Прошу прощения, если заголовок сформулирован неясно. Пожалуйста, вникните в следующий текст и, если кому-либо в голову придет более ясно сформулированное название темы - предложите, изменим.

Суть: есть n-ое кол-во книг в папке. Все книги - однообразны по структуре содержания модулей и алгоритм работы модулей у всех один. Бывает, что приходит озарение и появляется мысль о том, как оптимизировать работу какого-либо кода или изменить структуру userform. Каким образом я могу разом заменить модули во всех необходимых книгах путем использования VBA?
В голову лезет только импорт\экспорт модулей. Как это возможно реализовать через VBA ?
Спасибо!
Улыбнись.
Ошибка «Документ не сохранен». Какие возможные решения?
 
Доброго времени суток, многоуважаемые юзеры форума!

Суть темы:
В приложении файл, скачав и открыв который, вы можете кликнуть по форме с текстом «Сохранить лист как файл», а по завершению действий всех алгоритмов, module1 выдаст ошибку, которая повествует о том, что «Документ не сохранен.»

Пожалуйста, подскажите
-причину невозможности сохранения документа именно в моем случае;
-предположительное решение этой "проблемы".

Хорошего дня всем, кто уделил время на прочтение данного топика. Большое спасибо!
Код из module1
Код
Sub УдалитьМодули()
    'On Error Resume Next
    ИтоговаяКнига = Sheets(1).Name & " e-mail.xlsm"
    
    'Активируем кингу для отправки по e-mail
    Workbooks(ИтоговаяКнига).Activate
    
    'Удаляем Module и UserForm's
                    Set VBProj = ActiveWorkbook.VBProject.VBComponents
                    VBProj.Remove VBProj("ДобавитьНовогоКонтрагента")
                    VBProj.Remove VBProj("ДобавитьОснование")
                    VBProj.Remove VBProj("УдалитьОснование")
                    VBProj.Remove VBProj("УказатьОтветственного")
                    VBProj.Remove VBProj("Календарь")
                    VBProj.Remove VBProj("Module2")

            'Удаляем код из ЭтаКнига-------
            Dim oVBComponent As Object, lCountLines As Long
            Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ЭтаКнига")
            With oVBComponent
                lCountLines = .CodeModule.CountOfLines
                .CodeModule.DeleteLines 1, lCountLines
            End With
            Set oVBComponent = Nothing
            '------------------------------
     
'MsgBox "Сформирован отчет для [-  " & Sheets(1).Name & "  -]", vbOKOnly + vbInformation, ""

        Call Сохранить
                'ОтправляемФайл
                If ОтправляемФайл = True Then
                    
                    Dim FullStr As String
                
                    Смайлик = Sheets(1).Range("A7")
                
                    FullStr = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"
                    FullStr = FullStr & " -compose to=" & Почта
                    FullStr = FullStr & " ,subject=""" & Смайлик & "Транзакционный отчет [ " & ActiveWorkbook.ActiveSheet.Name & " ]"""
                    FullStr = FullStr & " ,body="" """
                    FullStr = FullStr & " ,attachment=" & ThisWorkbook.Path & "\" & ИтоговаяКнига

                    Shell FullStr, 1

                End If
                
Windows(ИтоговаяКнига).Activate
Call Сохранить

'Закрываем Книгу
'ActiveWindow.Close
End Sub

Sub Сохранить()
ActiveWorkbook.Save
End Sub

p.s. гуглил, но не нашел подходящей информации, поэтому обращаюсь к Вам, уважаемые!
Улыбнись.
Как отобразить символы из ячейки до и после определенного символа?
 
Доброго времени суток, уважаемые люди!
Подскажите, пожалуйста, каким образом  через VBA (именно VBA, а не формулы) возможно выделить и отобразить через MSGBOX, например,
те символы, что в ячейке, которая содержит в себе след. значение: « 12_2133_21:11:12 »
после первого _ (символа нижнего подчеркивания) и до второго _ (символа нижнего подчеркивания)

т.е. на выходе должно отображаться: « 2133 »

Благодарю за внимание!
Изменено: falmrom - 2 Июл 2019 21:14:45
Улыбнись.
Как запретить активацию листа с pivot-table после обновления PQ-запросов
 
Доброго времени суток, уважаемые! Подскажите, пожалуйста, каким образом возможно запретить активацию листа с таблицами, которые формирует PQ-запрос после того, как была дана команда на обновление этого запроса (в момент запроса активен лист1, а таблицы на листе2. После обновы - активируется лист2, которые содержит в себе все выходные из PQ таблицы с данными, что нужно запретить).
Спасибо!
Улыбнись.
Как создать дубликат Control в UserForm через VBA ?
 
Приветствую, уважаемые!

Подскажите, пожалуйста, каким образом возможно продублировать какой-либо Сontrol в Userform, СОХРАНИВ при этом полностью все параметры исходного Control'a (Name и Caption, высота, ширина, местоположение - изменятся)

Хорошего настроения каждому, кто уделил внимание! Спасибо!
Изменено: falmrom - 18 Июн 2019 15:32:05
Улыбнись.
VBA Перебор массивом CheckBox'ов в заданном диапазоне ( например, с 6 по 10)
 
Доброго времени суток, многоуважаемые форумчане! Будьте любезны, подскажите правильный синтаксис либо верное направление в гугле для того, чтобы перебрать переменные в следующем куске кода:

Пожалуйста, сильно не пинайте. Гуглил, но не понял. Если кто-то накидает хотя бы сырой пример кода, буду крайне признателен! Спасибо!
Кусок кода, который под вопросом:
Код
For Check = 1 To 6
For Check2 = 8 To 13


If CheckBox(Check).Value = True Then
Range("a" & Check).Value = TextBox(Check).Value
КолвоСтрок = КолвоСтрок + 1

    If TextBox(Check2).Value = 0 Then
        ВыбранноеТопливо = ВыбранноеТопливо & TextBox(Check).Value & Chr(10)
        Else
        ВыбранноеТопливо = ВыбранноеТопливо & TextBox(Check).Value & ":   " & TextBox(Check2).Value & " " & Валюта & Chr(10)
    End If
    
End If

Next
Next

Весь код:
Код
Private Sub CommandButton1_Click()
ActiveWorkbook.RemovePersonalInformation = False

'Выбираем валюту
If OptionButton1.Value = True Then Валюта = "л."
If OptionButton2.Value = True Then Валюта = "руб."


'Выбираем виды топлива.  Если стоит галочка, значит кнопка активна
КолвоСтрок = 0

For Check = 1 To 6
For Check2 = 8 To 13


If CheckBox(Check).Value = True Then
Range("a" & Check).Value = TextBox(Check).Value
КолвоСтрок = КолвоСтрок + 1

    If TextBox(Check2).Value = 0 Then
        ВыбранноеТопливо = ВыбранноеТопливо & TextBox(Check).Value & Chr(10)
        Else
        ВыбранноеТопливо = ВыбранноеТопливо & TextBox(Check).Value & ":   " & TextBox(Check2).Value & " " & Валюта & Chr(10)
    End If
    
End If

Next
Next

'If CheckBox1.Value = True Then Range("a1").Value = TextBox1.Value: КолвоСтрок = КолвоСтрок + 1: If TextBox8.Value = 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox1.Value & Chr(10): If TextBox8.Value > 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox1.Value & ":   " & TextBox8.Value & " " & Валюта & Chr(10)
'If CheckBox2.Value = True Then Range("a2").Value = TextBox2.Value: КолвоСтрок = КолвоСтрок + 1: If TextBox9.Value = 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox2.Value & Chr(10): If TextBox9.Value > 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox2.Value & ":   " & TextBox9.Value & " " & Валюта & Chr(10)
'If CheckBox3.Value = True Then Range("a3").Value = TextBox3.Value: КолвоСтрок = КолвоСтрок + 1: If TextBox10.Value = 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox3.Value & Chr(10): If TextBox10.Value > 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox3.Value & ":   " & TextBox10.Value & " " & Валюта & Chr(10)
'If CheckBox4.Value = True Then Range("a4").Value = TextBox4.Value: КолвоСтрок = КолвоСтрок + 1: If TextBox11.Value = 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox4.Value & Chr(10): If TextBox11.Value > 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox4.Value & ":   " & TextBox11.Value & " " & Валюта & Chr(10)
'If CheckBox5.Value = True Then Range("a5").Value = TextBox5.Value: КолвоСтрок = КолвоСтрок + 1: If TextBox12.Value = 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox5.Value & Chr(10): If TextBox12.Value > 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox5.Value & ":   " & TextBox12.Value & " " & Валюта & Chr(10)
'If CheckBox6.Value = True Then Range("a6").Value = TextBox6.Value: КолвоСтрок = КолвоСтрок + 1: If TextBox13.Value = 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox6.Value & Chr(10): If TextBox13.Value > 0 Then ВыбранноеТопливо = ВыбранноеТопливо & TextBox6.Value & ":   " & TextBox13.Value & " " & Валюта & Chr(10)

'Выводим ошибки о невыбранных параметрах
If КолвоСтрок = 0 Then MsgBox "" & vbNewLine & "" & vbNewLine & "Выберете вид топлива!" & vbNewLine & "" & vbNewLine & "", vbOKOnly + vbExclamation, "": Exit Sub
If Валюта = "" Then MsgBox "" & vbNewLine & "" & vbNewLine & "Выберете Литры или Рубли!" & vbNewLine & "" & vbNewLine & "", vbOKOnly + vbExclamation, "": Exit Sub


msg = MsgBox("Проверьте правильность указанных параметров." & vbNewLine & vbNewLine & vbNewLine & vbNewLine & _
"Виды топлива (" & КолвоСтрок & "):" & vbNewLine & vbNewLine & ВыбранноеТопливо & vbNewLine & vbNewLine & vbNewLine & _
"Валюта: " & vbNewLine & vbNewLine & Валюта & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & _
"Все верно?", vbYesNo + vbInformation, "Проверьте правильность указанных данных")
If msg = vbNo Then Exit Sub


Unload Me
End Sub
Улыбнись.
VBA Как изменить ГЛОБАЛЬНЫЕ уровни конфиденциальности в Параметрах запроса
 
Доброго времени суток, уважаемые!

Подскажите, пожалуйста, строки vba, которыми возможно менять уровни конфиденциальности в разделе «Параметры запроса»

Для корректной работы QP на различных машинах, необходимо постоянно устанавливать в параметрах «Всегда игнорировать параметры уровней конфиденциальности». Хотелось бы это дело автоматизировать.

Большое спасибо!






UPD:
Решение:


Код
Sub CreateNewZip(sPath As Str[SIZE=24pt][B][/B][/SIZE]ing)
    If Dir(sPath) <> "" Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub


Sub ИзвлечьВсеИзАрхива()
    
    On Error Resume Next
    
    '===Переменные==================
    ПапкаДляАрхива = "C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User"
    ПутьДоАрхива = ПапкаДляАрхива & ".zip"
    '===============================
    
    
    
    MkDir ПапкаДляАрхива ' создаем папку с именем архива
    
    
    
    '===Извлекаем файлы из архива===
    With CreateObject("Shell.Application")
    .Namespace((ПапкаДляАрхива)).CopyHere .Namespace((ПутьДоАрхива)).Items
    End With
    '===============================
    
    
    
    
    
    '===Меняем содержимое SETTINGS.XLM===
    Workbooks.OpenXML Filename:= _
        ПапкаДляАрхива & "\UserInterface\Settings.xml" _
        , LoadOption:=xlXmlLoadImportToList

    Kill ПапкаДляАрхива & "\UserInterface\Settings.xml"

    Cells.Find(What:="GlobalPrivacyLevel", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Range("B" & Selection.Row).Value = "l0"

    ActiveWorkbook.SaveAsXMLData Filename:= _
        ПапкаДляАрхива & "\UserInterface\Settings.xml" _
        , Map:=ActiveWorkbook.XmlMaps("UISettingsConfig_карта")
        
      ActiveWorkbook.Close False
    '===============================
    
    
    
    
    
    Kill ПутьДоАрхива    ' удаляем старый архив

    CreateNewZip (ПутьДоАрхива) 'создаем пустой ZIP-архив
    
    
    '===Помещаем папку обратно в архив=====================================
    With CreateObject("Shell.Application").Namespace(("C:\Users\" & Environ("UserName") & "\AppData\Local\Microsoft\Office\16.0\PowerQuery\User.zip"))
    .CopyHere CreateObject("Shell.Application").Namespace(ПапкаДляАрхива).Items
    End With
    '======================================================================

    
    '===Дожидаемся окончания архивации=====================================
    Do Until CreateObject("Shell.Application").Namespace((ПутьДоАрхива)).Items.Count = CreateObject("Shell.Application").Namespace((ПапкаДляАрхива)).Items.Count
        DoEvents
    Loop
    '======================================================================

    Shell "cmd /c rd /S/Q """ & ПапкаДляАрхива & """"     'ЗАМЕТАЕМ СЛЕДЫ ( удаляем временную папку )
End Sub


Изменено: falmrom - 19 Апр 2019 10:58:43
Улыбнись.
VBA Как отобразить путь САМОЙ МОЛОДОЙ ПАПКИ в директории
 
Доброго времени суток, уважаемые!

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

Благодарю!
Изменено: falm̅̅̃̄̅̂̂̈̄̀̀̀̀̆̄̂́́̀̄̀̂̂̂̈̈̃́̂̆̂̀̆̀̃́̆̀̂̀̀̈̆rom - 24 Апр 2019 13:46:13
Улыбнись.
Заставить Chrome скачать файл на машину через VBA
 
Доброго времени суток! Надеюсь, что всем понятна тяжелая формулировка заголовка темы.

Суть в следующем: существует книга.xlsm, которая формирует POST-запросы и отправляет их путем открытия окон с ссылками именно в CHROME.
Каким образом можно через VBA заставить chrome скачивать файл с сервера с полученным ответом на запрос?

Большое спасибо!

p.s. файл *.json

Код, которым отправляю запросы:
Код
cell = "https://admin.com/?page_size=9999"
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " " & cell)


-ПОЧЕМУ ЧЕРЕЗ ХРОМ?
-Потому что авторизацию я прохожу руками именно через хром.
Улыбнись.
Как пропустить ошибку при вызове несуществующего макроса ?
 
Доброго времени суток, уважаемые!

Суть в следующем:
Существует книга с n-ым кол-вом листов и модулей. В одном из модулей есть макрос, который, если коротко - копирует один из листов в новую книгу. Этот лист содержит в себе следующий код:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
                                       On Error Resume Next                             ' ОТКЛЮЧИТЬ ПОКАЗ ОШИБОК
                                       Application.DisplayAlerts = False                ' ОТКЛЮЧИТЬ ВЫВОД СИСТЕМНЫХ СООБЩЕНИЙ
                                       Application.ScreenUpdating = False               ' ОТКЛЮЧИТЬ ОБНОВЛЕНИЕ ЭКРАНА
                                       ActiveWorkbook.RemovePersonalInformation = False ' ОТКЛЮЧЕНИЕ ОКНА С ТЕКСТОМ О ПЕРСОНАЛЬНЫХ ДАННЫХ
'=========================================================================
    If ActiveSheet.Name <> "Операции с картами" Then Exit Sub
    Dim rng As Range: Set rng = [O23:O24] 'диапазон Вашей таблицы
    If Not Intersect(rng, Target) Is Nothing Then

    ApLe = Application.Left
    ApTo = Application.Top
    ApWi = Application.Width
    ApHe = Application.Height
    
    Call OK_ВыбратьНОМЕРАГруппКарт
    
    Application.Left = ApLe
    Application.Top = ApTo
    Application.Width = ApWi
    Application.Height = ApHe
    
    End If    
End Sub
Обратите внимание на    Call OK_ВыбратьНОМЕРАГруппКарт
Т.к. я копирую только лист из книги без модулей, то выполнение кода невозможно, т.к. В НОВОЙ книге модуль листа ссылается на несуществующий макрос.

Подскажите, пожалуйста, как пропустить эту ошибку, либо осуществить копирование листа без учета макросов в нем?

Спасибо!
Хорошего дня!
Улыбнись.
Поиск в столбец возможной части значения через «*» [Power Query}
 
Доброго времени суток. Подскажите, пожалуйста, верный синтаксис оформления пользовательского столбца:
Код
=if [Столбец1] = "*92*" then "Бензин АИ-92" else "Другое" 


Задача кода: найти в столбце значения, которые содержат в себе ЧАСТЬ текста и, если есть совпадение, в Пользовательском столбце сообщить об этом выводом указанной информации.

Спасибо!
Изменено: falmrom - 18 Мар 2019 08:47:53
Улыбнись.
Как скопировать диапазон с условным форматированием на новый лист вместе с установленным окрашиванием ячеек
 
Доброго времени суток. Подскажите, пожалуйста, как вместе с текстовой информацией из указанного диапазона скопировать еще и ФОРМАТИРОВАНИЕ (цвет ячеек ) ?

Файл-пример в приложении.

Проблема в том, что копируется все, кроме цвета ячеек. Точнее, он копируется, но криво. Цвет ячеек задается условным форматированием и, при копировании-вставке диапазона с условным форматированием в новое место ( лист, книга ), формулы условного форматирования сбиваются и цвета определяются некорректно.

Спасибо.
Улыбнись.
Узнать ИМЯ АКТИВНОГО объекта и ТЕКСТ, который он содержит в себе.
 
Доброго времени суток. Прикладываю файл с двумя объектами. Подскажите, пожалуйста, как можно узнать ИМЯ АКТИВНОГО ОБЪЕКТА и текст, который он в себе содержит.


По смыслу должно быть примерно следующее:

Код
sub 123()
msgbox object(selection).Name

msgbox object(selection).TextFrame
end SUB


Существует необходимость влиять на ИМЯ АКТИВНОГО объекта и его TextFrame , после выполнения определенных строк кода.

СПАСИБО!
Изменено: falmrom - 28 Фев 2019 09:18:08
Улыбнись.
Как заставить CMD после выполнения кода нажать "OK" в msgbox, что вызван макросом в excek?
 
Доброго времени суток. Собственно, САБЖ.

Есть .xlsm , в котором существует макрос, для полного выполнения задания которого задействована еще и командная строка. Необходимо как-то передать из cmd экселю весть о том, что код выполнен и нажать vbOk в msgbox, который умышленно притормаживает выполнение vba-кода, на время работы bat.
Код
sub 123()
for i=1 to 100

        if i = 50 then
           Shell ("C:\Program Files (x86)\Google\Chrome.bat")
           msgbox "Продолжить?", vbOk
           i = 100
        end if

next
end sub
Изменено: falmrom - 22 Фев 2019 15:13:17
Улыбнись.
Как через vba вежливо попросить хром скачать страницу/скрипт с сервера
 
Доброго времени суток. Необходимо путем vba через CHROME-браузер произвести скачивание скрипта по указанной ссылке. Подскажите, пожалуйста, каким образом Это возможно реализовать?

Большое спасибо!

Пример строки кода обычного открытия ссылки из vba через cmd в chrome:
Код
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe https://gpn-card.com/ajax/card/getCardsList/?page_size=9999")
Изменено: falmrom - 17 Дек 2018 09:15:42
Улыбнись.
Страницы: 1 2 3 След.
Наверх