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 Expandir vistaContraer vista
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 |
