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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 18 След.
Запись в реестр ПК из списка в домене, Запись значений из таблицы в компы которые находятся в домене
 
Цитата
написал:
У вас что конкретно не получается касающееся Excel
Методы, которые закомментированы в коде, якобы отвечающие за запись в реестр - не работают. При снятии апострофа - по каждому варианту - ошибка. Может в синтаксе где не так или еще что...может функция какая нужна на проверку доступа к записи на удаленном ПК...поэтому и прошу помощи...Просто странно, на чтение работает на "ура", а на запись не выходит, хотя принципиально все тоже самое: таблица с диапазонами IP, задаем ветку, говорим какой subKey, т.е...различается только в методе - чтение/запись
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Ок. Принято. Спасибо всем за помощь!
Запись в реестр ПК из списка в домене, Запись значений из таблицы в компы которые находятся в домене
 
Всем добра уважаемые форумчане!
Возникла необходимость записи значений из второго столбца (пример прилагаю) в определенную ветку реестра компов по списку, которые находятся в сети (в домене). Т.е., для ПК в A3 берется значение из B3 и записывается ему это значение в реестр. Пробовал многие параметры, в коде они закомментированы, но что-то видимо упускаю. Прошу подсказать правильное направление. Спасибо.
Изменено: Mike - 26.02.2024 17:33:59
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Спасибо всем! Разобрался немного.
Уж да простят меня модераторы, но не знаю создать новую ветку форума или эту добить... Вопрос в этом же направлении и с тем же принципом, т.е. IP берутся с одного столбца, значения параметра для, теперь уже, записи в реестр - с соседнего. Перепробовал много всякого (в самом коде есть комменты), но где то слышал, что для HKLM это не прокатывает, подскажите где подсмотреть пожалуйста.  
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Пытался внести проверку...если НЕ пингуется, то идти к следующему значению ( с соответствующей пометкой "0" или" "1" в ячейке 6 столбца), но, что то пошло не так...
Код
Sub regcrypto()
Dim intKeys, i As Integer, strKeys As Variant
Dim rowRange As Range
Dim LastRow As Long
Dim LastCol As Long
' Скрипт по сбору информации об установленном ПО
 
Const HKEY_LOCAL_MACHINE = &H80000002
LastRow = Cells(rows.Count, "A").End(xlUp).Row
Set rowRange = Range("A3:A" & LastRow)
LastCol = Cells(LastRow, 8).Column
Set colRange = Range(Cells(1, 1), Cells(LastRow, 7))
Arr_strValueName = Array("ProductID", "DisplayVersion", "InstallDate")

For Each cell In rowRange 'начало основного цикла

If Not Ping(strComputer) Then
cell.Offset(, 6).Value = 0
Else:
strComputer = cell.Value
Const ForWriting = 2
Const ForAppending = 8
Set objWsNet = CreateObject("WScript.Network")
Computer = objWsNet.ComputerName
User = objWsNet.UserName
cell.Offset(, 5).Value = 1

' указываем что oReg будет лезть в реестр
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
 
' Указываем куда именно в реестре мы полезем
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer" ' реальная ветка убрана для примера
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
' Перебор неких subkey в массиве arrSubKeys,

For Each SubKey In arrSubKeys
        strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\" & SubKey ' реальная ветка убрана для примера
j = 5
For Each strValueName In Arr_strValueName
j = j - 1
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, j).Value = strValue
        Else
        End If
Next
'End If

Next cell

End Sub
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Вроде разобрался. Выкладываю код, может кому пригодится:
Код
Sub regUpload ()
Dim intKeys, i As Integer, strKeys As Variant
Dim rowRange As Range
Dim LastRow As Long
Dim LastCol As Long
' Скрипт по сбору информации об установленном ПО
' информация берется из ветки реестра
' HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
' данные записываются в соответствующие ячейки
 Const HKEY_LOCAL_MACHINE = &H80000002
LastRow = Cells(rows.Count, "A").End(xlUp).Row
Set rowRange = Range("A3:A" & LastRow) ‘чтение списка IP начинается с A3
LastCol = Cells(LastRow, 5).Column ‘для определения диапазона таблицы указываем ячейку нижней правой области, т.е. «последняя определенная строка + последний столбец
Set colRange = Range(Cells(1, 1), Cells(LastRow, 1)) 
 For Each cell In rowRange ‘ здесь начинается основной цикл
strComputer = cell.Value ‘переменной присваивается значение ячейки из списка
Const ForWriting = 2
Const ForAppending = 8
Set objWsNet = CreateObject("WScript.Network")
Computer = objWsNet.ComputerName
User = objWsNet.UserName
 ' указываем что oReg будет лезть в реестр
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
 ' Указываем куда именно в реестре мы полезем
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall" ‘ в данном примере ветка реестра сокращена – нужно вставить свою, которая интересует
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
' Перебор неких subkey в массиве arrSubKeys,
' на самом деле шаримся по подразделам Uninstall`а
For Each SubKey In arrSubKeys
         strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey ‘ в конце слэш очень важен
        'Ищем в подразделах строковой параметр " ProductID " – выбран в качестве примера, вместо него можно вставить свой интересующий параметр в данной ветке реестра
        strValueName = "" ‘очищаем переменную
        strValueName = "ProductID"
        oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 4).Value = strValue ‘записываем в 4 столбец текущей строки
        Else
        i = 1
        End If
Next
 For Each SubKey In arrSubKeys
 ‘ далее еще два аналогичных цикла для двух других параметров текущей ветки реестра
        strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey
        'Ищем в подразделах строковой параметр " DisplayVersion "
        strValueName = ""
        strValueName = "DisplayVersion"
         oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 3).Value = strValue
        Else
        i = 1
        End If
Next
 For Each SubKey In arrSubKeys
        strKeyPath = " SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & SubKey
        'Ищем в подразделах строковой параметр " InstallDate "
        strValueName = ""
         strValueName = "InstallDate"
         oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, _
        strValueName, strValue
        If strValue <> Empty Then
        cell.Offset(, 2).Value = strValue
        Else
        i = 1
        End If
Next
 Next cell ‘ закрываем основной цикл
 
End Sub

Единственное, хочу все-таки "допилить" код на проверку ПК в онлайне, т.к. если ПК не в сети (не пингуется), то вылетает ошибка
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Цитата
написал:
уберите "Option Explicit"
Так он нигде не прописан...явно в коде не указан, а в опциях самого VB галочка убрана
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Цитата
написал:
Делайте функцию, которая по заданному ip опрашивает и возвращает то что нужно. можно массивом.дополнительно всеж рекомендую  Ping у Игоря полно  вариантов
Да! здорово! я ж помню, что был такой вариант опроса IP...Спасибо, обязательно дополнением вставлю.
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Пишет, что subkey - пустой, может его надо было раньше объявить?
Изменено: Mike - 21.02.2024 15:05:38
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
на самом деле ветка реестра лезет в раздел установленных программ и ищет там версию (если есть така прога) , дату установки и (возможно) серийник...и соответственно напротив каждого IP заносит эти сведения в таблицу...повторюсь, "в нахалку" по единичному IP макрос работает, т.е....лезет, выдергивает, записывает в явно указанные ячейки
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
В этом отшении берутся IP тех компов, которые в сети со сторонней программы. Кстати, видел где-то средствами VB можно реализовать опрос ПК в диапазоне IP на предмет "онлайн" через определенный промежуток времени, возможно, в дальнейшем найду и реализую эту процедуру, но пока хочется реализовать эту малую часть задумки.
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
С сеткой все норм...как единичное обращение макрос справляется.
Сбор сведений из реестра Win в домене, Сбор сведений из ветки реестра для заданного диапазона IP
 
Всем доброго дня!
Прошу разобраться с макросом. Что-то видимо заработался...В примере есть таблица с указанными IP в определенном диапазоне. Хотелось бы брать каждый IP из сети, сканировать определенную ветку его (ПК) реестра и заносить соответственно в текущую строку в определенные столбцы значения реестра. Уж простите, давно в VB не сидел. Далее по циклу - берется следующая строка...и так до первой попавшейся пустой строки в конце диапазона. Помогите пожалуйста с циклом - совсем запутался.
Изменено: Mike - 21.02.2024 11:38:23
Перекрестный поиск в таблице, Осуществить поиск и подстановку значений из массива данных
 
Спасибо! разобрался! все работает.
Перекрестный поиск в таблице, Осуществить поиск и подстановку значений из массива данных
 
Приветствую всех Гуру экселя!
Помогите с формулой (файл прилагаю). В файле все обезличено и сокращено. Забил формулу в ячейку (обозначено желтым), но пишет ошибку, хотя логика довольна понятна. Это пример выгрузки результатов тестирования людей.
Преобразование всех файлов в папке, Преобразование xml в xlsx
 
Немного модернизирована идея...должно со всех xml вставится данные в один файл, но...

Ругается на LBound...

может где-то в декларировании типа не то?


Код
Sub Sbor()
     Dim MyPath As String
     Dim SourceRcount As Long, Fnum As Long
     Dim mybook As Workbook, BaseWks As Worksheet
     Dim sourceRange As Range, destrange As Range
     Dim rnum As Long, CalcMode As Long
     Dim SaveDriveDir As String
     Dim FName As String
    With Application
         CalcMode = .Calculation
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
         .EnableEvents = False
     End With
    SaveDriveDir = CurDir
     ChDir "E:\2023 год\ТЕСТИРОВАНИЕ\тест"
 
 FName = Application.Workbooks.OpenXML("*.xml", , LoadOption:=xlXmlLoadImportToList)
   
  If IsArray(FName) Then
         Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
         rnum = 1
         For Fnum = LBound(FName) To UBound(FName) ' Здесь ругается на массив
             Set mybook = Nothing
             On Error Resume Next
             Set mybook = Workbooks.Open(FName(Fnum))
             On Error GoTo 0
             If Not mybook Is Nothing Then
                 On Error Resume Next
                 With mybook.Worksheets(1)
                     Set sourceRange = .Range("A1:BR50")
                 End With
                 If Err.Number > 0 Then
                     Err.Clear
                     Set sourceRange = Nothing
                 Else
         If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                         Set sourceRange = Nothing
                     End If
                 End If
                 On Error GoTo 0
                If Not sourceRange Is Nothing Then
                    SourceRcount = sourceRange.Rows.Count
                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                         MsgBox "Больше нет строк "
                         BaseWks.Columns.AutoFit
                         mybook.Close savechanges:=False
                         GoTo ExitTheSub
                     Else
                         Set destrange = BaseWks.Range("A" & rnum)
                         With sourceRange
                             Set destrange = destrange. _
                                             Resize(.Rows.Count, .Columns.Count)
                         End With
                         destrange.Value = sourceRange.Value
                        rnum = rnum + SourceRcount
                     End If
                 End If
                 mybook.Close savechanges:=False
             End If
         Next Fnum
         BaseWks.Columns.AutoFit
     End If
ExitTheSub:
     With Application
         .ScreenUpdating = True
         .EnableEvents = True
         .Calculation = CalcMode
     End With
     ChDir SaveDriveDir
 End Sub
Преобразование всех файлов в папке, Преобразование xml в xlsx
 
Доброго дня уважаемые форумчане!
Подскажите, как макросом преобразовать все файлы с расширением xml в папке в формат xlsx, причем чтобы открытие файла происходило именно как "xml-таблица" с последующим сохранением в формат xlsx. Сами файлы имеют структуру вида "content_??.xml", где "??" - нумерация файлов.
Вывод всех ячеек по условию
 
Спасибо! все получилось!
Вывод всех ячеек по условию
 
Супер! Спасибо! только срабатывает на первое вхождение...а если в массиве предложений стоит например не "абрикос желтый", а "желтый абрикос", тогда формула перестает понимать...можно что-то с этим придумать? Пожалуйста.  
Вывод всех ячеек по условию
 
Добрый день уважаемые форумчане! Запутался в многообразии примеров ))) и все не то...Есть массив предложений в одном столбце, есть критерий поиска по слову, содержащейся в предложении ячейки, нужно вывести все варианты ячеек с этим словом в отдельный столбец. Прошу помочь в решении, желательно формулой с применением массива...
Найденные мной примеры либо ищут в массиве с несколькими столбцами, либо формулу надо "растягивать", либо делать дополнительный столбец, либо поиск по двум критериям и вывод третьего, либо на VBA все...
Защита форм среза
 
Отлично! Спасибо!
Защита форм среза
 
Доброго дня!
Вопрос о защите формы среза сводной таблицы...При "защите листа", если в форме "среза" стоит галка "защищаемый объект", то подразумевается, что пользователь не сможет перенести форму среза в другую область листа, изменить его размер и т.д. (естественно, если в окне "защита листа" убрана галка "изменение объектов" + до этого в свойствах среза выставлен "не перемещать и не изменять размеры")...так вот, но и выбрать пункты среза пользователь тоже не может...как так? как настроить, чтобы пользователь не мог изменять форму среза, но мог не ней делать выбор пунктов?
P.S.: office 2016
Вывод информации в определенную форму согласно условиям среза
 
Доброго дня! Я уж прошу прощения у модераторов, но дабы не плодить темы с одинаковым файлом и направлением, немного отойдя в сторону защиты формы, возник вопрос...При "защите листа", если в форме "среза" стоит галка "защищаемый объект", то подразумевается, что пользователь не сможет перенести форму среза в другую область листа, изменить его размер и т.д. (естественно, если в окне "защита листа" убрана галка "изменение объектов" + до этого в свойствах среза выставлен "не перемещать и не изменять размеры")...так вот, но и выбрать пункты среза пользователь тоже не может...как так? как настроить, чтобы пользователь не мог изменять форму среза, но мог не ней делать выбор пунктов?
Вывод информации в определенную форму согласно условиям среза
 
Спасибо! Все получилось...модернизирую конечно под себя, но мне главное принцип :) СПАСИБО!
Вывод информации в определенную форму согласно условиям среза
 
Всем доброго времени суток! Подскажите кто может, вопрос вот в чем, можно ли по условиям среза, чтоб только определенные данные отображались в нужной форме? Если это возможно, то как это реализовать? (Office 2016)
Изменено: vikttur - 01.12.2021 20:22:57
Градиентная заливка выделяемой ячейки
 
БМВ, Все замечательно, спасибо! только вот есть глюк небольшой...при вводе в 6-ю строку любого значения (не принципиально какого) она принимает вид предыдущей строки, передвинем курсор на пятую строку (столбца А), а потом вниз на две строки, и получается что на шестой строке остается ячейка с градиентом...это можно как-то поправить?  
Градиентная заливка выделяемой ячейки
 
БМВ, все замечательно, а как это сделать только в ограниченном диапазоне? Ввожу значение ниже, и он "подхватывает" УФ с предыдущих, а мне такого не надо :)
Градиентная заливка выделяемой ячейки
 
Доброго дня уважаемые форумчане!
Подскажите пожалуйста по коду на VB, не получается сделать градиент ячейки. Идея взята из "приемов" - координатное выделение.
В самом файле более полный код, в апостроф взяты строки, созданные макрорекордером.
Хотелось бы получить желаемую активную ячейку.
Код
Dim r As Range
Application.EnableEvents = False
For Each r In Range("A1:A5")
If Not (Intersect(Target, r) Is Nothing) Then
   'Здесь код, который окрашивает активную ячейку
r.Font.FontStyle = "полужирный"
r.Font.Size = 14
r.Font.ThemeColor = xlThemeColorLight1
r.Borders.LineStyle = xlContinuous
r.Borders.ThemeColor = 5
r.Borders.TintAndShade = 0.599963377788629
r.Borders.Weight = xlThin
r.Interior.Color = RGB(169, 203, 233)

Cells(r.Row, 2).Value = "В итоге получается такой"

Else:
r.Interior.Color = RGB(221, 235, 247)
r.Font.FontStyle = "обычный"
r.Font.Size = 12
r.Font.ThemeColor = xlThemeColorLight1
r.Borders.LineStyle = xlContinuous
r.Borders.ThemeColor = 5
r.Borders.TintAndShade = 0.599963377788629
r.Borders.Weight = xlThin
Cells(r.Row, 2).Value = ""
End If
Next r
Изменено: Mike - 29.09.2021 13:27:22
Перенос информации из массива на листы по шаблону
 
Огромное Вам спасибо! все получилось!
Перенос информации из массива на листы по шаблону
 
Получилось пока так макрорекордером (немного подкорректировал правда), но уверен, этот код не совершенен:
Код
For i = 2 To 50   'для пробы взял пока 50
    Sheets("Инфа").Select
    Sheets("Инфа").Range("B4:J5").Cut
    Sheets(i).Select
    Range("B9").Select
    ActiveSheet.Paste
    Sheets("Инфа").Select
    Sheets("Инфа").Range("K4").Copy
    Sheets(i).Select
    Range("H4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Инфа").Select
    Sheets("Инфа").Rows("4:5").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Sheets("Инфа").Select
    Range("B4").Select
Next i
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 18 След.
Наверх