Ayuda con una función de archivo XML de Excel

Para discutir temas generales, incluso si no tienen que ver directamente con Apache OpenOffice
Responder
andreslmata
Mensajes: 1
Registrado: Dom May 05, 2013 4:12 pm

Ayuda con una función de archivo XML de Excel

Mensaje por andreslmata »

Buenas a todos, por favor si alguien me puede ayudar, he buscado por todos lados y foros y este me parece que tiene las mejores respuesta al tema pero son muy técnicas, yo no se nada de programación, yo uso excel y tengo un archivo que solo me pasan la plantilla y yo lo lleno y me da un archivo xml pero ahora me da un error 75 probe en office 2003 y sigue el mismo error y ya no se que hacer, por favor si me pueden ayudar en ese se los agradecería, el error que me da en depurar es el siguiente open xmlfilename for output as #1

Copie toda la función para ver que me pueden decir pero por favor díganme que colocar, yo no se nada de programación, el error lo puse en rojo y tamaño grande y de antemano gracias por la ayuda

Código: Seleccionar todo

Sub MakeXML()

Dim MyRow As Integer, MyCol As Integer, Temp As String, YesNo As Variant, DefCarpeta As String
Dim XMLFileName As String, XMLRecSetName As String, MyLF As String, RTC1 As Integer
Dim RangeOne As String, RangeTwo As String, Tt As String, FldName(99) As String
Dim LastRow As Variant, Fila As Variant, Tipo As Integer, Fecha As String
Dim Inicial As Double, Final As Double, BI As Double, IVA As Double, Texta As String, Switch As Integer
Dim Periodo As Double, PeriodoElab As Double
Dim Base As Double

Dim SubTotMont As Double

MyLF = Chr(10) & Chr(13)    ' comando de line feed
'DefCarpeta = "C:\Documents and Settings\SerigrafiC.A\Escritorio\SERIGRAFI"
DefCarpeta = "C:\Documents and Setting\All Users\Escritorio\"

YesNo = MsgBox("Este Procedimiento requiere conocer la cantidad de filas del archivo !!" & MyLF _
 & "Ya determino la cantidad de filas ?", vbQuestion + vbYesNo, "Rutina XML Seniat")
 
If YesNo = vbNo Then
 Debug.Print "El Usuario aborto con un 'No'"
 Exit Sub
End If
  
XMLFileName = "XML_relacionRetencionesISLR_" & Cells(2, 8).Value & ".xml"

XMLRecSetName = "DetalleRetencion"

FldName(0) = "RifRetenido"
FldName(1) = "NumeroFactura"
FldName(2) = "NumeroControl"
FldName(3) = "CodigoConcepto"
FldName(4) = "MontoOperacion"
FldName(5) = "PorcentajeRetencion"


'*** Se coloca manual la cantidad de fila ***
   'RangeTwo = InputBox("Indique ahora cual es la última operación :", "Rutina XML Seniat")
'****

'RangeTwo = InputBox("Indique ahora cual es el numero de la última operación :", "Rutina XML SENIAT")
RangeOne = Cells(1, 8).Value
RangeTwo = Cells(1, 8).Value
'YesNo = MsgBox("& RangeTwo &", vbQuestion + vbYesNo, "Rutina XML SENIAT")

 MsgBox "La Cantidad de filas son  " & RangeOne & ".", vbOKOnly + vbInformation, "Rutina XML SENIAT"


  MyRow = 5
  LastRow = RangeTwo
   Cells(1, 10).Value = LastRow
   'Periodo = Left(Cells(2, 7), 4) & Mid(Cells(2, 7), 6, 2)
   For Fila = MyRow To LastRow + 4
      Inicial = 1
      Final = 1
      
      
      SubTotMont = Cells(Fila, 6) * (Cells(Fila, 7) / 100) + SubTotMont
      
      
      
      errorRif = 0
      
      'Validación del Rif del Agente
      RIFAgente = Left(Cells(1, 7).Value, 1)
      'MsgBox (RIFAgente)
      If RIFAgente <> "V" And RIFAgente <> "J" And RIFAgente <> "G" And RIFAgente <> "E" And RIFAgente <> "P" And RIFAgente <> "v" And RIFAgente <> "j" And RIFAgente <> "g" And RIFAgente <> "e" And RIFAgente <> "p" Then
         Switch = 1
         errorRif = 1
         Cells(1, 7).Select
         Texta = "Error: Tipo de naturaleza RIF invalido"
         Retorno = ResaltarErrores(Fila, Texta)
      End If
      
      'Validación del Rif del Agente(Largo)
      RIFAgente = Len(Cells(1, 7).Value)
      If RIFAgente <> 10 Then
         Switch = 1
         errorRif = 1
         Cells(1, 7).Select
         Texta = "Error: RIF invalido"
         Retorno = ResaltarErrores(Fila, Texta)
      End If

      'Validación del Rif del Agente (Numérico)
      If Not IsNumeric(Right(Cells(1, 7).Value, 9)) Then
         Switch = 1
         errorRif = 1
         Cells(1, 7).Select
         Texta = "Error: RIF no numérico"
         Retorno = ResaltarErrores(Fila, Texta)
      End If
      
      
      If errorRif = 0 Then
         Cells(1, 7).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If
      
' ********************************************************************************************

      ErrorPeriodo = 0
      
      'Validación del Periodo (Largo)
      Periodo = Len(Cells(2, 7).Value)
      If Periodo <> 6 Then
         Switch = 1
         ErrorPeriodo = 1
         Cells(2, 7).Select
         Texta = "Error: Periodo invalido"
         Retorno = ResaltarErrores(Fila, Texta)
      End If
      
      'Validación del Periodo (Numérico)
      If Not IsNumeric(Cells(2, 7).Value) Then
         Switch = 1
         ErrorPeriodo = 1
         Cells(2, 7).Select
         Texta = "Error: No numérico"
         Retorno = ResaltarErrores(Fila, Texta)
      End If
      
      
      If ErrorPeriodo = 0 Then
         Cells(2, 7).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If
      
' ********************************************************************************************
      
      errorRif = 0
      
      'Validación del Rif
      RIF = Left(Cells(Fila, 2).Value, 1)
      If RIF <> "V" And RIF <> "J" And RIF <> "G" And RIF <> "E" And RIF <> "P" And RIF <> "v" And RIF <> "j" And RIF <> "g" And RIF <> "e" And RIF <> "p" Then
         Switch = 1
         errorRif = 1
         Cells(Fila, 2).Select
         Texta = "Error: Tipo de naturaleza RIF invalido"
         Retorno = ResaltarErrores(Fila, Texta)
      End If
      
      'Validación del Rif (Largo)
      RIFLargo = Len(Cells(Fila, 2).Value)
      If RIFLargo <> 10 Then
         Switch = 1
         errorRif = 1
         Cells(Fila, 2).Select
         Texta = "Error: RIF invalido"
         Retorno = ResaltarErrores(Fila, Texta)
      End If

      'Validación del Rif (Numérico)
      If Not IsNumeric(Right(Cells(Fila, 2).Value, 9)) Then
         Switch = 1
         errorRif = 1
         Cells(Fila, 2).Select
         Texta = "Error: RIF no numérico"
         Retorno = ResaltarErrores(Fila, Texta)
      End If

      If errorRif = 0 Then
         Cells(Fila, 2).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If


' ********************************************************************************************

     'Validación del Num. de la Factura (No sea mayor a 10)
     NumFactura = Len(Cells(Fila, 3).Value)
     'MsgBox (NumFactura)
      If NumFactura <= 0 Or NumFactura > 10 Then
         Switch = 1
         Cells(Fila, 3).Select
         Texta = "Error: Factura invalida"
         Retorno = ResaltarErrores(Fila, Texta)
       Else
         Cells(Fila, 3).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If

' ********************************************************************************************

      'Validación del Numero de Control
      numeroControl = Len(Cells(Fila, 4).Value)
      'MsgBox (numeroControl)
      If numeroControl < 1 Or numeroControl > 8 Then
         Switch = 1
         Cells(Fila, 4).Select
         Texta = "Error: Número de Control invalido"
         Retorno = ResaltarErrores(Fila, Texta)
       Else
         Cells(Fila, 4).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If
      
         
' ********************************************************************************************
      
      'Validación del códigoConcepto
      If Not IsNumeric(Right(Cells(Fila, 5).Value, 7)) Then
         Switch = 1
         Cells(Fila, 5).Select
         Texta = "Error: Sólo Números"
         Retorno = ResaltarErrores(Fila, Texta)
      Else
         Cells(Fila, 5).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If
      
      
' ********************************************************************************************

     ErrorMonto = 0
     
     'Validación del MontoOperacion (No sea menor a cero (0))
     MontoOperacion = Cells(Fila, 6).Value
     
     If MontoOperacion = "" Then
         Switch = 1
         ErrorMonto = 1
         Cells(Fila, 6).Select
         Texta = "Error: Debe colocar el monto de la operación"
         Retorno = ResaltarErrores(Fila, Texta)
     End If
     
      If MontoOperacion < 0 Then
         Switch = 1
         ErrorMonto = 1
         Cells(Fila, 6).Select
         Texta = "Error: No puede ser menor a 0"
         Retorno = ResaltarErrores(Fila, Texta)
      End If
     
      'Validación del MontoOperacion (Numérico)
      If Not IsNumeric(Cells(Fila, 6).Value) Then
          Switch = 1
          ErrorMonto = 1
          Cells(Fila, 6).Select
          Texta = "Error: Monto Invalido"
          Retorno = ResaltarErrores(Fila, Texta)
          Else: Cells(Fila, 6).Select
                Selection.NumberFormat = "0.00"
                MontoOperacion = Cells(Fila, 6).Value
      End If
                
      If ErrorMonto = 0 Then
         Cells(Fila, 6).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If
                
                MontoOperacion = Replace(Cells(Fila, 6), ",", ".")
                Cells(Fila, 8).NumberFormat = "@"
                Cells(Fila, 8) = MontoOperacion
                                
     
' ********************************************************************************************
     
     ErrorPorcentaje = 0
     
     Porcentaje = Cells(Fila, 7).Value
     
     If Porcentaje = "" Then
         Switch = 1
         ErrorPorcentaje = 1
         Cells(Fila, 7).Select
         Texta = "Error: Debe colocar el monto del porcentaje"
         Retorno = ResaltarErrores(Fila, Texta)
     End If
     
     'Validación del Porcentaje (No mayor a 100)
     Porcentaje = Cells(Fila, 7).Value
      If Porcentaje > 100 Then
         Switch = 1
         ErrorPorcentaje = 1
         Cells(Fila, 7).Select
         Texta = "Error: No puede ser mayor a 100"
         Retorno = ResaltarErrores(Fila, Texta)
      End If

    'Validación del Porcentaje (No menor a 0)
     Porcentaje = Cells(Fila, 7).Value
      If Porcentaje < 0 Then
         Switch = 1
         ErrorPorcentaje = 1
         Cells(Fila, 7).Select
         
         Texta = "Error: No puede ser menor a 0"
         Retorno = ResaltarErrores(Fila, Texta)
      End If

      'Validación del Porcentaje (Numérico)
      If Not IsNumeric(Cells(Fila, 7).Value) Then
          Switch = 1
          ErrorPorcentaje = 1
          Cells(Fila, 7).Select
          Texta = "Error: Porcentaje invalido"
          Retorno = ResaltarErrores(Fila, Texta)
          Else: Cells(Fila, 7).Select
               Selection.NumberFormat = "0.00"
               Porcentaje = Cells(Fila, 7).Value
      End If


      If ErrorPorcentaje = 0 Then
         Cells(Fila, 7).Select
         Retorno = QuitarErrores(Fila, Texta)
      End If

               Porcentaje = Replace(Cells(Fila, 7), ",", ".")
               Cells(Fila, 9).NumberFormat = "@"
               Cells(Fila, 9) = Porcentaje
      
     
Next Fila

'MsgBox SubTotMont
Cells(5, 11).Value = SubTotMont

If Switch <> 1 Then


     If InStr(1, XMLFileName, ":\") = 0 Then
        XMLFileName = DefCarpeta & XMLFileName
     End If

[b][size=200][color=#FF0000]Open XMLFileName For Output As #1[/color][/size][/b]
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "ISO-8859-1" & Chr(34) & "?>"

' Print #1, "<" & "Rif_imprenta A=" & Chr(34) & Cells(1, 8).Value & Chr(34); " " & "Periodo_declaracion=" & Chr(34) & Cells(2, 8).Value & Chr(34) & ">"
' Print #1, "<" & "Rif_imprenta RIF=" & Chr(34) & Cells(1, 8).Value & Chr(34); " " & "Periodo_declaracion=" & Chr(34) & Cells(2, 8).Value & Chr(34) & ">"

  Print #1, "<" & "RelacionRetencionesISLR RifAgente=" & Chr(34) & Cells(1, 7).Value & Chr(34); " " & "Periodo=" & Chr(34) & Cells(2, 7).Value & Chr(34) & ">"


For MyRow = 5 To LastRow + 4
' Print #1, "<" & XMLRecSetName & Chr(34) & ">"
Print #1, "<" & XMLRecSetName & ">"
  'For MyCol = 2 To 13
    For MyCol = 2 To 5
     If MyCol = 5 And Cells(MyRow, MyCol).Value = "" Then

        ElseIf MyCol = 9 And Cells(MyRow, MyCol).Value = "" Then

        ElseIf MyCol = 10 And Cells(MyRow, MyCol).Value = "" Then

        Else
        
      
      'If MyCol < 4 Then
        
        'If MyCol = 3 Then
        '  Print #1, "<" & FldName(MyCol - 2) & ">" & Format(Cells(MyRow, MyCol).Value, "0000000000") & "</" & FldName(MyCol - 2) & ">"

        
        
        'ElseIf MyCol = 4 Then
        '   Print #1, "<" & FldName(MyCol - 2) & ">" & Format(Cells(MyRow, MyCol).Value, "00000000") & "</" & FldName(MyCol - 2) & ">"
        'Else
        '   Print #1, "<" & FldName(MyCol - 2) & ">" & Cells(MyRow, MyCol).Value & "</" & FldName(MyCol - 2) & ">"
     
      'End If


        
        If MyCol = 5 Then
           Print #1, "<" & FldName(MyCol - 2) & ">" & Format(Cells(MyRow, MyCol).Value, "000") & "</" & FldName(MyCol - 2) & ">"
        Else
            Print #1, "<" & FldName(MyCol - 2) & ">" & Cells(MyRow, MyCol).Value & "</" & FldName(MyCol - 2) & ">"
        End If
        
     End If

   Next MyCol
   
     Print #1, "<" & FldName(4) & ">" & Cells(MyRow, 8).Value & "</" & FldName(4) & ">"
     Print #1, "<" & FldName(5) & ">" & Cells(MyRow, 9).Value & "</" & FldName(5) & ">"
   
   
   Print #1, "</" & XMLRecSetName & ">"
 Next MyRow
  Print #1, "</RelacionRetencionesISLR>"
  Close #1
  MsgBox XMLFileName & " created." & MyLF & "Empaquetamiento del XML concluido", vbOKOnly + vbInformation, "Rutina XML Seniat"
  Debug.Print XMLFileName & " saved"
Else: MsgBox "Por detectarse errores, no se genero el XML"
End If

End Sub

Function ResaltarErrores(Filla As Variant, Texto As String)
' resaltar errores y enviar mensaje
            With Selection.Interior
              .ColorIndex = 6
              .Pattern = xlSolid
            End With
            MsgBox Texto & MyLF _
            
End Function

Function QuitarErrores(Filla As Variant, Texto As String)
' resaltar errores y enviar mensaje
            With Selection.Interior
              .ColorIndex = 0
              
              .Pattern = xlSolid
            End With
            
            
End Function
 Editado: (por el administrador, RGB-es) para cambiar el «todo mayúsculas» y agregar las etiquetas «CODE». Si no lo has hecho aún por favor lee la Guía de supervivencia 
windows 8 office 2010
Arriba
xiseme
Mensajes: 1918
Registrado: Lun Nov 24, 2008 1:13 pm

Re: Ayuda con una función de archivo XML de Excel

Mensaje por xiseme »

... , yo uso excel ...
que es algo que NO se usa EN ESTE FORO, orientado a Apache OpenOffice /LibreOffice .. y sus aplicaciones Calc, Writer, Draw ...
Debes preguntarlo en un foro de Microsoft-Office (o tal vez/también a quien te pasa la plantilla)
Todo es mejorable, estamos dispuestos a mejorar. ¿Yo? ... poco a poco.
Nunca hay acritud en mis comentarios, si lo pareciera, seguro que me he expresado mal.
Arriba
Responder

Volver a “Discusión general”