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.