Date: prev next · Thread: first prev next last


OK, aqui va toda la macro:

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 = "/home/moliveira/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"
XMLFileName = "XML_relacionRetencionesISLR.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


      If Cells(Fila, 5) = 2 Or _
        Cells(Fila, 5) = 6 Or _
        Cells(Fila, 5) = 10 Or _
        Cells(Fila, 5) = 12 Or _
        Cells(Fila, 5) = 14 Or _
        Cells(Fila, 5) = 18 Or _
        Cells(Fila, 5) = 25 Or _
        Cells(Fila, 5) = 49 Or _
        Cells(Fila, 5) = 53 Or _
        Cells(Fila, 5) = 57 Or _
        Cells(Fila, 5) = 61 Or _
        Cells(Fila, 5) = 71 Or _
        Cells(Fila, 5) = 73 Or _
        Cells(Fila, 5) = 75 Or _
        Cells(Fila, 5) = 77 Or _
        Cells(Fila, 5) = 79 Or _
        Cells(Fila, 5) = 83 Or _
        Cells(Fila, 5) = 91 Then

        varx = Cells(7, 11) * (Cells(Fila, 7) / 100) * 83.3334

        SubTotMontAc = (Cells(Fila, 6) * (Cells(Fila, 7) / 100)) - varx

        If SubTotMontAc < 0 Then
            SubTotMontAc = 0
        End If

        Else

          SubTotMontAc = Cells(Fila, 6) * (Cells(Fila, 7) / 100)
        End If

      SubTotMont = SubTotMontAc + 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

Open XMLFileName For Output As #1
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



El 6 de junio de 2011 14:02, Mauricio Baeza <mauricio@correolibre.net>escribió:

El lun, 06-06-2011 a las 13:53 -0430, Germana Oliveira escribió:

Saludos!!

Tengo una macro en Excel que quiero que pueda ser ejecutada en Calc, por
lo
que me es preciso arreglar lo que halla que editar, o si es necesario
re-hacerla. El error que me arroja primero es en la siguiente linea:

Dim Base as Double
El Error es : Error de sintaxis de Basic. Simbolo esperado.

Si comento esta linea, entonces el error es:
Error e ejecucion de BASIC '1'
Type: com.sun.star.uno.RuntimeException
Message: unsatisfied query for interface of type ooo.vba.excel.XWorksheet

y todo esto en la linea:
XMLFileName = "XML_relacionRetencionesISLR_" & Cells(2, 8).Value & ".xml"

Cualquier ayuda, seria bienvenida.

GRACIAS



Hola...

En vez de ir corrigiendo línea por línea, mejor muestra toda la macro,
es más fácil ayudarte de este modo...


Saludos


--
__________________________________
Mauricio Baeza Servín
Universo Libre México, A.C.
Fundador y Director General

Todo lo que no podemos dar nos posee... Andre Gide

--
Unsubscribe instructions: E-mail to users+help@es.libreoffice.org
Posting guidelines + more: http://wiki.documentfoundation.org/Netiquette
List archive: http://listarchives.libreoffice.org/es/users/
All messages sent to this list will be publicly archived and cannot be
deleted




-- 
Germana Oliveira

"Fool me once, shame on you. Fool me dozens of times, I'm an Apple
customer."

-- 
Unsubscribe instructions: E-mail to users+help@es.libreoffice.org
Posting guidelines + more: http://wiki.documentfoundation.org/Netiquette
List archive: http://listarchives.libreoffice.org/es/users/
All messages sent to this list will be publicly archived and cannot be deleted

Context


Privacy Policy | Impressum (Legal Info) | Copyright information: Unless otherwise specified, all text and images on this website are licensed under the Creative Commons Attribution-Share Alike 3.0 License. This does not include the source code of LibreOffice, which is licensed under the Mozilla Public License (MPLv2). "LibreOffice" and "The Document Foundation" are registered trademarks of their corresponding registered owners or are in actual use as trademarks in one or more countries. Their respective logos and icons are also subject to international copyright laws. Use thereof is explained in our trademark policy.