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

Страницы: 1
Run-time error '424': Object required, Проблема excel
 
Вариант не работает, а вот по поводу библиотек можно подробнее
Run-time error '424': Object required, Проблема excel
 
Код
  Dim row As Integer
    Dim col As Integer
    Dim n As Integer
    Dim s As Integer

   'Dim aVal As Integer
    Dim Root As IXMLDOMElement
    Dim moduleNode As IXMLDOMElement
    Dim sceneElement As IXMLDOMElement
    Dim questionElement As IXMLDOMElement
    Dim txtElement As IXMLDOMElement
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim dom As DOMDocument30
    Dim strName As String
    Dim strId As String
    Dim intLoop As Integer
    Dim mySeal As String
    

Sub createQuestions()
    Set wb = ActiveWorkbook
    'SÖKVÄG
    For sheetNum = 1 To wb.Worksheets.Count
    xName = Left(ActiveWorkbook.name, Len(ActiveWorkbook.name) - 4) 'kapar bort .xls
    Set fs = CreateObject("Scripting.FileSystemObject")
    XPath = ActiveWorkbook.Path & "\xml\"
    'MsgBox xName
    If fs.FolderExists(XPath) = False Then
        MkDir (XPath)
    End If
    '''''
    
    'bPath = XPath & "\bilder\"
    'If fs.FolderExists(bPath) = False Then
        'MkDir (bPath)
    'End If
    
    'blnTypeIn = False
    '''''
    
    'Set ws = wb.ActiveSheet
    
    'MsgBox wb.Worksheets.Count
    
    Set dom = New DOMDocument30
    dom.async = False
    Set ws = wb.Worksheets(sheetNum)
    Set node = dom.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
    dom.appendChild node
    Set node = Nothing
    
    
    courseName = ws.Cells(2, 2)
    customer = ws.Cells(3, 2)
    random = ws.Cells(4, 2)
    percent = ws.Cells(5, 2)
    lang = ws.Cells(7, 2)
    xName = spaceReplace(xName & "_" & lang)
    Set Root = dom.createElement("module")
    'Call makeAttrNode("id", Root, createGUID())
    Call makeAttrNode("lang", Root, lang)
    Call makeAttrNode("percent", Root, percent)
    Call makeAttrNode("course", Root, courseName)
    Call makeAttrNode("created", Root, Now())
    Call makeAttrNode("updated", Root, "")
    SceneId = 0
    col = 9
    qNum = 0
    Do While col < 1000
        If ws.Cells(col, 1) <> "" Then
            SceneId = SceneId + 1
            qNum = 0
            aNum = 0
            If SceneId < 10 Then
                sceneNr = "0" & SceneId & "0"
            Else
                sceneNr = SceneId & "0"
            End If
            qPoolName = ws.Cells(col, 2)
            numberOf = ws.Cells(col + 1, 2)
            'numberOf = ws.Cells(col + 1, 2)
            Call makeSceneElements(sceneNr, "", qPoolName, numberOf)
            col = col + 2
        End If
        
        If ws.Cells(col, 2) = "Question text:" Then
            qNum = qNum + 1
            If qNum < 10 Then
                qNr = sceneNr & "_0" & qNum & "0"
            Else
                qNr = sceneNr & "_" & qNum & "0"
            End If
            Call makeQuestionElements(name, qNr, ws.Cells(col, 5))
            Call makeTxtElements(ws.Cells(col, 3), "typeval", "Q_" + qNr)
            
        End If
        If ws.Cells(col, 2) = "Answer alternative:" Then
            a = col
            Do While a < (col + 10)
            
            txt = Trim(ws.Cells(a, 4))
            If txt = "" Then Exit Do
            If txt <> "" Then
            aNum = aNum + 1
            If aNum < 10 Then
                aNr = sceneNr & "_0" & aNum & "0"
            Else
                aNr = sceneNr & "_" & aNum & "0"
            End If
            Call makeAnswerElements(txt, ws.Cells(a, 3), aNr)
            
            End If
            a = a + 1
            Loop
        End If
        Do While row < 5
        
            
            row = row + 1
        Loop
        col = col + 1
    Loop
    MsgBox ("File saved: " & XPath & xName & ".xml")
    dom.appendChild Root
    'dom.Save (XPath & MyValue & ".xml")
    dom.Save (XPath & xName & ".xml")
    Next sheetNum
End Sub


Sub putInMenu()
    With Application.CommandBars("File")
    i = 0
    For i = 1 To (.Controls.Count - 2)
        If .Controls(i).Caption = "Make An XML" Then
            .Controls(i).Delete
        End If
    Next i
    .Controls.Add msoControlButton, , , 7
    .Controls(7).Caption = "Make An XML"
    .Controls(7).OnAction = "createQuestions"
    End With
End Sub

Private Sub makeSceneElements(idNum, template, name, orderNum)
    Call makeElementNode("scene", sceneElement, Root)
    Call makeAttrNode("id", sceneElement, idNum)
    Call makeAttrNode("quantity", sceneElement, orderNum)
    'Call makeAttrNode("type", sceneElement, "normal")
    Call makeAttrNode("template", sceneElement, template)
    Call makeAttrNode("name", sceneElement, name)
    
    'Call makeAttrNode("hide", sceneElement, "true or false")
End Sub

Private Sub makeQuestionElements(name, orderNum, img)
    Call makeElementNode("question", questionElement, sceneElement)
    Call makeAttrNode("id", questionElement, orderNum)
    Call makeAttrNode("image", questionElement, img)
    'Call makeAttrNode("name", questionElement, "")
    'Call makeAttrNode("order", questionElement, orderNum)
    'Call makeAttrNode("type", questionElement, "")
    'Call makeAttrNode("goto", questionElement, "maybe a label for flash ")
    'Call makeAttrNode("hide", questionElement, "true or false")
End Sub

Private Sub makeAttrNode(name, ByRef node As IXMLDOMElement, val)
    Set attr = dom.createAttribute(name)
    attr.Value = val
    node.setAttributeNode attr
    Set attr = Nothing
End Sub
Private Sub makeElementNode(name, ByRef node As IXMLDOMElement, ByRef appendNode As IXMLDOMElement)
    Set node = dom.createElement(name)
    appendNode.appendChild node
End Sub
Private Sub makeTxtElements(texten, typeval, orderNum)
    Call makeElementNode("txt", txtElement, questionElement)
    Call makeAttrNode("id", txtElement, orderNum)
    Set cdataNode = dom.createCDATASection(texten)
    txtElement.appendChild cdataNode
    'Call makeAttrNode("ref", txtElement, refId)
    'Call makeAttrNode("order", txtElement, orderNum)
    'Call makeAttrNode("type", txtElement, typeval)
    'Call makeAttrNode("goto", txtElement, "") 'maybe a label in flash
    'Call makeAttrNode("style", txtElement, "") ' styleName
    'Call makeAttrNode("hide", txtElement, "true or false")
End Sub
Private Sub makeAnswerElements(texten, state, orderNum)
    Call makeElementNode("answer", txtElement, questionElement)
    Call makeAttrNode("id", txtElement, orderNum)
    Call makeAttrNode("state", txtElement, state)
    Set cdataNode = dom.createCDATASection(texten)
    txtElement.appendChild cdataNode
    'Call makeAttrNode("ref", txtElement, refId)
    'Call makeAttrNode("order", txtElement, orderNum)
    'Call makeAttrNode("type", txtElement, typeval)
    'Call makeAttrNode("goto", txtElement, "") 'maybe a label in flash
    'Call makeAttrNode("style", txtElement, "") ' styleName
    'Call makeAttrNode("hide", txtElement, "true or false")
End Sub
'funktion för att trimma namn
Function GetName(ToTrim)
    Dim intTemp
    intTemp = InStr(ToTrim, " ")
    ToTrim = Left(ToTrim, intTemp - 1)
    GetName = ToTrim
End Function
Function spaceReplace(strCurrent)
    strReplaced = Replace(strCurrent, " ", "_")
    strReplaced = LCase(strReplaced)
    spaceReplace = strReplaced
End Function

Run-time error '424': Object required, Проблема excel
 
Цитата
Казанский написал: node
ДА - исправиль
Run-time error '424': Object required, Проблема excel
 
Всем привет, народ помогите баг исправить
Run-time error '424': Object required

Код
Private Sub makeElementNode(name, ByRef node As IXMLDOMElement, ByRef appendNode As IXMLDOMElement)
    Set node = dom.createElement(name)
    appendNod.appendChild node  ' выделяет эту страку при дебаге
End Sub
Изменено: zlodeh - 23.02.2016 16:56:13
Страницы: 1
Наверх