Напишите в сообшении новое название, и модераторы поменяют А ошибка скорее всего происходит из за того, что объект не найден, и нечего присваивать., Без файла сложно сказать. Можете прогнать код с помощью F8 и посмотреть чему равны переменные и находит ли программа в поиске то, что задано как эталон. Может нет значения Loko на листе, вот и возвращается ошибка.
Вал Бал написал: Здравствуйте подскажите пожалуйста, можно ли как-то подключить надстройку только к определенному файлу excel? Если можно то как?
Смысл надстройки, что бы при открытии любого файла макросы были в них доступны, какой смысл делать надстройку для конкретного файла? Перенесите все процедуры в этот файл и будут они доступны, только в этом файле.
Sub main()
Dim xml As MSXML2.DOMDocument60
Dim sb$
Dim xNode As IXMLDOMElement
Dim xRoot As IXMLDOMElement
Set xml = New MSXML2.DOMDocument60
sb = Chr(62) & vbNewLine & Chr(60)
xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
Set xRoot = xml.createElement("Document")
xRoot.setAttribute "xmlns:xsi", "http://blabla/2001/blablabla"
xRoot.setAttribute "xmlns:dtr", "http://blabla.ru/blabla/blabla"
Set xNode = xml.createElement("Rows")
xNode.appendChild xml.createElement("row")
xNode.appendChild xml.createElement("row")
xNode.appendChild xml.createElement("row")
xRoot.appendChild xNode
xml.appendChild xRoot
xml.LoadXML Replace(xml.xml, "><", sb)
MsgBox xml.xml
End Sub
Как видно, второй вариант xml документа отличается от первого тем что перед каждым значением тега стоит "dtr:"
PS: Вариант добаления путем сцепления сейчас использую
Скрытый текст
Код
Sub main()
Dim xml As MSXML2.DOMDocument60
Dim sb$
Dim xNode As IXMLDOMElement
Dim xRoot As IXMLDOMElement
Set xml = New MSXML2.DOMDocument60
sb = Chr(62) & vbNewLine & Chr(60)
xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
Set xRoot = xml.createElement(getNS & "Document")
xRoot.setAttribute "xmlns:xsi", "http://blabla/2001/blablabla"
xRoot.setAttribute "xmlns:dtr", "http://blabla.ru/blabla/blabla"
Set xNode = xml.createElement(getNS & "Rows")
xNode.appendChild xml.createElement(getNS & "row")
xNode.appendChild xml.createElement(getNS & "row")
xNode.appendChild xml.createElement(getNS & "row")
xRoot.appendChild xNode
xml.appendChild xRoot
xml.LoadXML Replace(xml.xml, "><", sb)
MsgBox xml.xml
End Sub
Function getNS()
getNS = "dtr:"
End Function
Интересует есть ли какие-то штатные методы у MSXML2.DOMDocument60 , а не этот костыль
Работа со сканером бар-кода через UserForm с последующим поиском пустой ячейки в столбце/спуском на ячейку ниже., Кто понимает и кому не лень, прошу помощи, с меня как обычно.
Работа со сканером бар-кода через UserForm с последующим поиском пустой ячейки в столбце/спуском на ячейку ниже., Кто понимает и кому не лень, прошу помощи, с меня как обычно.
Антон Зума написал: 7) Не представляю как крутить дальше эту кашу.
Я тоже не понимаю сути вопроса. Открыл файл и вывалился в ошибку, не открывается UserForm1, каково же было мое удивление , когда я этот объект вообще не обнаружил в файле
"Все гениальное просто, а все простое гениально!!!"
GRIM, Коллега, позволил немного подправить Ваш код, и получилось как-то так:
Код
Private Sub UserForm_Initialize()
Dim i&, j&
For j = 2 To 4
Me.Controls("ComboBox" & j).Clear
With CreateObject("scripting.dictionary")
For i = 2 To Worksheets("Список").Cells(Rows.Count, 2).End(xlUp).Row
If Worksheets("Список").Cells(i, 1) = "Ресурсы" Then
If Not .Exists(Trim(Worksheets("Список").Cells(i, 2))) Then
.Add Trim(Worksheets("Список").Cells(i, 2)), i
Me.Controls("ComboBox" & j).AddItem Worksheets("Список").Cells(i, 2).Value
End If
End If
Next i
End With
Next j
End Sub
"Все гениальное просто, а все простое гениально!!!"
Я вам показал как это можно сделать, загоните группы комбобоксов во фреймы и обрабатывайте по аналогии. Я бы только осмысленные названия комбобоксам дал, а не дефолтные оставил.
Sub test()
Dim rngUR As Range
Dim rngBlank As Range
Set rngUR = Intersect(ActiveWorkbook.ActiveSheet.UsedRange, ActiveWorkbook.ActiveSheet.Range("d:f"))
Set rngBlank = rngUR.Find("")
While Not rngBlank Is Nothing
rngBlank.Value = rngBlank.Offset(-1, 0).Value
Set rngBlank = rngUR.Find("", rngBlank)
Wend
End Sub
Sub OpenDialod()
Dim ipath$, fname$, book As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then ipath = .SelectedItems(1) Else Exit Sub
End With
fname = Dir(ipath & "\*.xls*")
Do While fname <> ""
Set book = Workbooks.Open(ipath & Application.PathSeparator & fname)
Call Общиймакрос
book.Close True
fname = Dir
Loop
End Sub