Macro para hacer un leyout

H o l a:

No veo en cuál línea tienes el error supongo que es la línea que pusiste en negritas.

Pero tendría que ver la macro completa, para revisar las variables.

Por ejemplo, tienes en tu macro esto:

Range("U" & N)

Pero no veo cuánto vale "N", si "N" esta vacía te va a marcar error.

También tienes esto:

Format(F - 1

Supongo que F es un número y le estás restando uno, pero tampoco veo cuánto vale F

Revisa que N tenga un valor numérico.

Si corregiste el problema, recuerda valorar la respuesta.

Si continúa el problema, pon la macro completa o envíame tu archivo para revisar la macro.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Eduardo Mejia” y el título de esta pregunta.

Que tal Dante muchas gracias no aun no lo corrijo 

Aqui esta la macro

Sub Macro1Layout()
On Error GoTo 10
Dim MaxLay As Integer
Dim CodTran As String
Dim Facred As String
Dim CodBenef As String
Dim Ejecucion As Integer
Dim Mc As String
Dim RutaArch As String
Dim Vendor As String
Dim Nombre As String
Dim Nom As String
Dim Docu As String
Dim Documento As String
Dim Df As String
Dim Beneficiario As String
Dim Cuen As String
Dim Dire As String
Dim Dir1 As String
Dim BancoBen As String
Dim Cuenta As String
Dim CuentaPago As String
Dim Extra1 As String
Dim Titulo As String
Dim Correo As String
Dim Pmaximo As String
Dim Actualiza As String
Dim ExtraFin As String
Dim Be As String
Dim Secuencia As String
Dim N As Integer
Dim H As Integer
Dim K As String
Dim J As Integer
Dim F As Integer
Dim Total As Variant
Dim Yea As Variant
Dim Mes As Variant
Dim Dia As Variant
Dim Fi1 As Variant
Dim Importe As Variant
Dim Impuesto As Variant
Dim Fecha_expira As String
Dim Esp30 As String
Dim Esp351 As String
Dim Esp352 As String
Dim Esp353 As String
Dim Esp354 As String
Dim Narch As Integer
Dim CuentaN As Integer
Dim Vacios As Integer
Dim Tini As String
Dim CtaSalida As Integer
Dim CadRFC As String
Dim LenRFC As Integer
Mc = "Macro citydirect"
RutaArch = Hoja1.Cells(4, 5) '"C:\JMG\CITYDIRECT\"
Ejecucion = 0
' cuentapago = InputBox("No de cuenta a usar", "No de cuenta para realizar pagos")
CuentaPago = Hoja1.Cells(4, 2)
If Trim(CuentaPago) = "" Then
MsgBox "Número de cuenta incorrecta.", vbCritical, Mc
Exit Sub
End If
Tini = Time
Call LimpiaAreaTrabajo
ChDir "C:\"
Workbooks.OpenText Filename:=RutaArch & "Holdfile_" & CuentaPago & ".txt", Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(6, _
1), Array(38, 2), Array(49, 2), Array(59, 2), Array(69, 2), Array(85, 2), Array(93, 2), _
Array(106, 2), Array(116, 2)), TrailingMinusNumbers:=True
N = 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
'ELIMINAMOS LAS CABECERAS DEL ARCHIVO.
Do While K <> ""
If Range("A" & N) = ".BP .N" Then
Rows(N & ":" & N + 10).Select
Selection.Delete Shift:=xlUp
End If
N = N + 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
Loop
N = 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
'ELIMINAMOS LAS LINEAS EN BLANCO
Do While K <> ""
If Range("E" & N) & Range("B" & N) & Range("C" & N) & Range("D" & N) & Range("F" & N) & Range("G" & N) = "" Then
Rows(N & ":" & N).Select
Selection.Delete Shift:=xlUp
N = N - 1
End If
N = N + 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
Loop
N = 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
'COMPLEMENTAMOS LINEAS.
Do While K <> ""
Vendor = Range("A" & N)
Nombre = Range("B" & N)
H = 1
For J = 1 To 1000
If Range("A" & N + H) = "" Then
Range("A" & N + H) = Range("A" & N)
Range("B" & N + H) = Range("B" & N)
Else
J = 10000
End If
H = H + 1
Next J
If H > 2 Then
N = N + H - 1
Else
N = N + 1
End If
K = ""
For MaxLay = 0 To 100
K = K & Range("C" & N + MaxLay)
Next
' K = Range("C" & N) & Range("C" & N + 1) & Range("C" & N + 2) & Range("C" & N + 3) & Range("C" & N + 4) & Range("C" & N + 5) & _
' Range("C" & N + 6) & Range("C" & N + 7) & Range("C" & N + 8) & Range("C" & N + 9) & Range("C" & N + 10) & _
' Range("C" & N + 11) & Range("C" & N + 12) & Range("C" & N + 13) & Range("C" & N + 14) & Range("C" & N + 15) & _
' Range("C" & N + 16) & Range("C" & N + 17) & Range("C" & N + 18) & Range("C" & N + 19) & Range("C" & N + 20)
Loop
N = 1
H = 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
'AGRUPAMOS LAS REFERENCIAS
Do While K <> ""
Vendor = Range("A" & N)
Nombre = Range("B" & N)
Docu = ""
Do While Range("A" & N) = Range("A" & H)
Docu = Docu & " " & Range("C" & H)
H = H + 1
Loop
Range("C" & N) = Docu
' Esp35 = Docu
Docu = ""
N = H - 1
N = N + 1
H = N
K = ""
For MaxLay = 0 To 100
K = K & Range("C" & N + MaxLay)
Next
' K = Range("C" & N) & Range("C" & N + 1) & Range("C" & N + 2) & Range("C" & N + 3) & Range("C" & N + 4) & Range("C" & N + 5) & _
' Range("C" & N + 6) & Range("C" & N + 7) & Range("C" & N + 8) & Range("C" & N + 9) & Range("C" & N + 10) & _
' Range("C" & N + 11) & Range("C" & N + 12) & Range("C" & N + 13) & Range("C" & N + 14) & Range("C" & N + 15) & _
' Range("C" & N + 16) & Range("C" & N + 17) & Range("C" & N + 18) & Range("C" & N + 19) & Range("C" & N + 20)
Loop
'BUSCAMOS INFORMACION Y ELIMINAMOS REGISTROS REPETIDOS.
N = 1
Do While Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20) <> ""
Range("T" & N) = "=VLOOKUP(RC[-19],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C9,9,0)" 'tipo de pago
Range("K" & N) = "=VLOOKUP(RC[-10],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C11,11,0)" 'cuenta
Range("L" & N) = "=VLOOKUP(RC[-11],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C3,3,0)" 'pais
Range("M" & N) = "=VLOOKUP(RC[-12],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C12,12,0)" 'banco
Range("N" & N) = "=VLOOKUP(RC[-13],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C13,13,0)" 'mail
Range("O" & N) = "=VLOOKUP(RC[-14],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C14,14,0)" 'mail2
Range("P" & N) = "=VLOOKUP(RC[-15],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C15,15,0)" 'mail3
Range("Q" & N) = "=VLOOKUP(RC[-16],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C16,16,0)" 'mail4
Range("R" & N) = "=VLOOKUP(RC[-17],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C17,17,0)" 'mail5
Range("S" & N) = "=VLOOKUP(RC[-18],'[macro citydirect.xlsm]VENDORS'!R2C1:R383C18,18,0)" 'rfc
If Range("H" & N) & Range("I" & N) & Range("J" & N) = "" Then
Rows(N & ":" & N).Select
Selection.Delete Shift:=xlUp
N = N - 1
End If
N = N + 1
Loop
'MARCAMOS LINEAS N/A PARA QUE SEAN IGNORADAS.
Columns("K:K").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("K:K").Select
Selection.Replace What:="""N/A""", Replacement:="-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="#N/A", Replacement:="-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Total = 0
N = 1
F = 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
'PREPARAMOS EL LAYOUT DE SALIDA.
Do While K <> ""
If Range("k" & N) <> "-" Then
Yea = Mid(Year(Date), 3, 2)
Mes = Format(Month(Date), "00") '''
Dia = Format(Day(Date), "00")
Fi1 = Yea & Mes & Dia
Documento = Fi1 & Format(Hour(Time), "00") & Format(Minute(Time), "00") & Format(Second(Time), "00") & " "
Secuencia = Format(F, "00000000")
' RFC = "X MXN"
If Range("S" & N) = "0" Then
Range("S" & N) = ""
End If
CadRFC = Replace(Range("S" & N), " ", "")
Range("S" & N) = CadRFC
RFC = CadRFC & String(20 - Len(Mid(CadRFC, 1, 20)), " ") & "MXN"
Beneficiario = Mid(Range("A" & N), 1, 20)
Be = Beneficiario & String$(20 - Len(Beneficiario), " ")
Be = Replace(Be, ".", " ")
Beneficiario = Be
Importe = Format((Range("H" & N)) * 100, "000000000000000")
Total = Total + Range("H" & N) * 100
Impuesto = Val(Range("H" & N)) - (Val(Range("H" & N)) / 1.16)
Impuesto = Format(Impuesto * 100, "00000000000000000")
Fecha_expira = " " 'FI1
Esp35 = " "
Esp351 = Mid(LTrim(Range("C" & N)), 1, 35)
Df = Esp351 & String$(35 - Len(Esp351), " ")
Esp351 = LimpiaCadena(Df)
Esp352 = Mid(LTrim(Range("C" & N)), 36, 35)
Df = Esp352 & String$(35 - Len(Esp352), " ")
Esp352 = LimpiaCadena(Df)
Esp353 = Mid(LTrim(Range("C" & N)), 71, 35)
Df = Esp353 & String$(35 - Len(Esp353), " ")
Esp353 = LimpiaCadena(Df)
Esp354 = Mid(LTrim(Range("C" & N)), 106, 35)
Df = Esp354 & String$(35 - Len(Esp354), " ")
Esp354 = LimpiaCadena(Df)
Esp30 = " "
Nombre = Mid(Range("B" & N), 1, 35)
Nom = Nombre & String$(80 - Len(Nombre), " ")
Nombre = LimpiaCadena(Nom)
'Range("K" & n) = "=VLOOKUP(RC[-10],'[macro citydirect.xls]VENDORS'!R2C1:R383C11,11,0)"
'Range("L" & n) = "=VLOOKUP(RC[-11],'[macro citydirect.xls]VENDORS'!R2C1:R383C3,3,0)"
Cuenta = Range("K" & N)
If Len(Cuenta) = 16 Then tipoc = "03"
If Len(Cuenta) = 18 Then tipoc = "05"
If InStr(UCase(Range("M" & N)), "BANAMEX") > 0 Then
' CodBenef = "000"
' Facred = " "
CodTran = "072"
Else
' CodBenef = "002"
' Facred = "01"
CodTran = "001"
End If
CodBenef = Range("T" & N)
Facred = "01"
Cuen = Cuenta & String$(35 - Len(Cuenta), " ")
Cuenta = Cuen
Dire = Mid(Range("L" & N), 1, 35)
Dir1 = Dire & String$(35 - Len(Dire), " ")
Dire = LimpiaCadena(Dir1)
BancoBen = "BcoBenef "
CuentaPago = Trim(Cuenta)
If Len(CuentaPago) = 18 Then
CuentaPago = Mid(CuentaPago, 8, 11) & " "
End If
Extra1 = " "
Titulo = " 00000"
If Range("N" & N) = "" Then
Range("N" & N) = " "
End If
Correo = Range("N" & N) & String$(50 - Len(Mid(Range("N" & N), 1, 50)), " ")
Pmaximo = "999999999999999"
If Correo <> "" Then
Actualiza = " E-Mail "
Else
Actualiza = " NONE "
End If
ExtraFin = String$(253, " ")
Range("U" & N) = "PAY485 " & _
Fi1 & _
CodTran & _
Documento & _
Secuencia & _
RFC & _
Beneficiario & _
Importe & _
Fecha_expira & _
Esp351 & _
Esp352 & _
Esp353 & _
Esp354 & _
"0601" & _
Nombre & _
Dire & _
Esp35 & _
Esp30 & _
CodBenef & " " & _
Cuenta & _
tipoc & _
BancoBen & _
Impuesto & _
"NN" & Facred & _
CuentaPago & Extra1 & " " & Titulo & Correo & Pmaximo & Actualiza & ExtraFin
F = F + 1
End If
N = N + 1
K = ""
For MaxLay = 0 To 100
K = K & Range("B" & N + MaxLay)
Next
' K = Range("b" & N) & Range("b" & N + 1) & Range("b" & N + 2) & Range("b" & N + 3) & Range("b" & N + 4) & Range("b" & N + 5) & _
' Range("b" & N + 6) & Range("b" & N + 7) & Range("b" & N + 8) & Range("b" & N + 9) & Range("b" & N + 10) & _
' Range("b" & N + 11) & Range("b" & N + 12) & Range("b" & N + 13) & Range("b" & N + 14) & Range("b" & N + 15) & _
' Range("b" & N + 16) & Range("b" & N + 17) & Range("b" & N + 18) & Range("b" & N + 19) & Range("b" & N + 20)
Loop
Ejecucion = Ejecucion
10:
Ejecucion = Ejecucion + 1
If Ejecucion > 1 Then
MsgBox Err.Number & "" & Err.Description, vbCritical, Mc
Exit Sub
End If
Range("U" & N) = "TRL" & Format(F - 1, "000000000000000") & Format(Total, "000000000000000") & "000000000000000" & Format(F - 1, "000000000000000") & " "
Call CopiaHoldfile
'creamos el archivo de texto
Narch = 1
Narch = FreeFile
Open RutaArch & "Pagos.txt" For Output As #Narch
Hoja1.Range("A6:A1000").Clear
Hoja1.Range("A6:A1000").Font.Name = "Courier New"
CtaSalida = 7
For CuentaN = 1 To 32000
' If Trim(Hoja5.Cells(CuentaN, 16)) <> "" Then
If Hoja5.Cells(CuentaN, 11) <> "-" And Hoja5.Cells(CuentaN, 21) <> "" Then
Print #Narch, Hoja5.Cells(CuentaN, 21)
Hoja1.Cells(CtaSalida, 1) = Hoja5.Cells(CuentaN, 21)
If Hoja5.Cells(CuentaN, 14) <> "" And Hoja5.Cells(CuentaN, 14) <> 0 Then
Hoja1.Cells(CtaSalida, 12) = Hoja5.Cells(CuentaN, 14)
If Hoja5.Cells(CuentaN, 15) <> "" And Hoja5.Cells(CuentaN, 15) <> 0 Then
Hoja1.Cells(CtaSalida, 13) = Hoja5.Cells(CuentaN, 15)
Else
Hoja1.Cells(CtaSalida, 13) = " "
End If
Else
Hoja1.Cells(CtaSalida, 12) = " "
Hoja1.Cells(CtaSalida, 13) = " "
End If
CtaSalida = CtaSalida + 1
Vacios = 0
Else
Vacios = Vacios + 1
If Vacios > 100 Then Exit For
End If
Next
Close #Narch
'RESUMEN
Range("L1") = "Encontrados"
Range("M1") = CtaSalida - 8
'reportamos los registros ignorados.
Hoja1.Cells(CtaSalida, 1) = "REGISTROS NO ENCONTRADOS"
CtaSalida = CtaSalida + 1
Hoja1.Cells(CtaSalida, 1) = "BENEFICIARIO"
Hoja1.Cells(CtaSalida, 2) = "NOMBRE"
Hoja1.Cells(CtaSalida, 8) = "IMPORTE"
CtaSalida = CtaSalida + 1
For N = 1 To 32000
If Hoja5.Cells(N, 11) = "" Then Exit For
If Hoja5.Cells(N, 11) = "-" Then
Hoja1.Cells(CtaSalida, 1) = Hoja5.Cells(N, 1)
Hoja1.Cells(CtaSalida, 2) = Hoja5.Cells(N, 2)
Hoja1.Cells(CtaSalida, 8) = Format(Hoja5.Cells(N, 8), "###,###,###.00")
CtaSalida = CtaSalida + 1
End If
Next
Range("L2") = "No encontrados"
Range("M2") = CtaSalida - Val(Range("M1")) - 10
Range("L3") = "Total"
Range("M3") = Range("M2") + Range("M1")
'marcamos lineas
'BUSCAMOS EL FINAL DE LA INFORMACION SOBRE LA COLUMNA 1 (A) QUE TRAE LOS PRODUCTOS.
For N = 8 To 32000
If Range("A" & N) = "" Then Exit For
Next
Fin = N - 1
LinBlanca = True
Ini = 7
Do While Ini <= Fin
If LinBlanca = True Then
Call LineaBlanca(Ini)
LinBlanca = False
Else
Call LineaCian(Ini)
LinBlanca = True
End If
Ini = Ini + 1
Loop
Hoja1.Range("A7").Select
MsgBox "Proceso terminado." & vbCrLf & _
"Hora inicio : " & Tini & vbCrLf & _
"Hora fin : " & Time, vbInformation, Mc
End Sub
Function LimpiaCadena(Cadena) As String
Dim Cadenax As String
Cadenax = Cadena
Cadenax = Replace(Cadenax, "^", " ")
Cadenax = Replace(Cadenax, "`", " ")
Cadenax = Replace(Cadenax, "~", " ")
Cadenax = Replace(Cadenax, "\", " ")
Cadenax = Replace(Cadenax, "¬", " ")
Cadenax = Replace(Cadenax, "@", " ")
Cadenax = Replace(Cadenax, "|", " ")
Cadenax = Replace(Cadenax, "°", " ")
Cadenax = Replace(Cadenax, "<", " ")
Cadenax = Replace(Cadenax, ">", " ")
Cadenax = Replace(Cadenax, "-", " ")
Cadenax = Replace(Cadenax, ".", " ")
Cadenax = Replace(Cadenax, ",", " ")
Cadenax = Replace(Cadenax, "}", " ")
Cadenax = Replace(Cadenax, "{", " ")
Cadenax = Replace(Cadenax, "+", " ")
Cadenax = Replace(Cadenax, "´", " ")
Cadenax = Replace(Cadenax, "¿", " ")
Cadenax = Replace(Cadenax, "_", " ")
Cadenax = Replace(Cadenax, ":", " ")
Cadenax = Replace(Cadenax, ";", " ")
Cadenax = Replace(Cadenax, "]", " ")
Cadenax = Replace(Cadenax, "[", " ")
Cadenax = Replace(Cadenax, "*", " ")
Cadenax = Replace(Cadenax, "¨", " ")
Cadenax = Replace(Cadenax, "¡", " ")
Cadenax = Replace(Cadenax, "?", " ")
Cadenax = Replace(Cadenax, "=", " ")
Cadenax = Replace(Cadenax, ")", " ")
Cadenax = Replace(Cadenax, "(", " ")
Cadenax = Replace(Cadenax, "/", " ")
Cadenax = Replace(Cadenax, "%", " ")
Cadenax = Replace(Cadenax, "$", " ")
Cadenax = Replace(Cadenax, "#", " ")
Cadenax = Replace(Cadenax, Chr(34), " ")
Cadenax = Replace(Cadenax, "!", " ")
LimpiaCadena = Cadenax
End Function
Sub CerrarArchPagos()
'
' CerrarArch Macro
'

'
Windows("macro citydirect.xlsm").Activate
Range("B5").Select
Sheets("Hoja1").Select
Range("A1").Select
Windows("Holdfile_" & Hoja1.Cells(5, 2) & ".txt").Activate
Range("M1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("macro citydirect.xlsm").Activate
ActiveSheet.Paste
Windows("Holdfile_" & Hoja1.Cells(5, 2) & ".txt").Activate
ActiveWindow.Close SaveChanges:=False
Sheets("Macro").Select
Range("C5").Select
End Sub

Sub MacroPosteos()
Dim Mc As String
Dim CuentaPago As String
Mc = "Macro citydirect"
CuentaPago = Hoja1.Cells(5, 2)
If Trim(CuentaPago) = "" Then
MsgBox "Número de cuenta incorrecta.", vbCritical, Mc
Exit Sub
End If
Call LimpiaAreaTrabajo
Call AbreArchRef(CuentaPago)
Call MacroX
End Sub

Sub MacroX()
' MACRO RESURTIDOS
' CREADO POR: JUAN MARTINEZ GARCIA (INCUBOZ SYSTEMS)
' FECHA: 13 DE JUNIO DE 2012
' USUARIO: ROCIO HERNANDEZ

Dim TiempoIni As String
Dim Gtotal As Variant
Dim LinBlanca As Boolean
Dim HojaX As String
Dim Upc As String
Dim Estado As String
Dim Precio As String
Dim Producto As String
Dim Vari As String
Dim VarConP As Integer
Dim NVar As Integer
Dim CeldaEnc As String
Dim Cuenta As Integer
Dim Cta As Integer
Dim Mc As String
Dim Ini As Integer
Dim IniT As String
Dim Columnas As String
Dim Letra As String
Dim Macro As Variant
Dim Fin As Variant
Dim ColSalida As String
Dim ColSalida2 As String
Dim ColDato As String
Dim ColReg As String
Dim NvoReg As String
Dim Reg As Integer
Dim Np As Variant
Dim Ntp As Variant
Dim Nr As Variant
Dim Llave As String
Dim Complem As Boolean
Dim FinColumna As Boolean
Dim FinProc As Boolean
Dim PoTotal As Variant
Dim ArchSalida As String
Dim Crojo As Integer
Dim Camarillo As Integer
Dim Cblanco As Integer
Dim Crosa As Integer
Dim PrimProd As String
Dim PrimVar As String
'PARAMETROS GENERALES DE LA AUTOMATIZACION.
ArchSalida = "C:\PICK.xls"
' ArchSalida = "C:\JMG\PICK.xls"
ColSalida = "BF"
ColSalida2 = "BG"
ColDato = "BE"
ColReg = "BD"
Mc = "MACRO WILSON MEXICO"
W = 10
'BUSCAMOS EL FINAL DE LA INFORMACION SOBRE LA COLUMNA 1 (A) QUE TRAE LOS PRODUCTOS.
For Cuenta = 8 To 32000
If Range("A" & Cuenta) = "" Then Exit For
Next
Fin = Cuenta - 1
'LIMPIAMOS AREA DE SALIDA DE DATOS.
Call LimpiaColBEBF
'PONEMOS LOS DATOS DE INICIO DE SESION.
Range(ColSalida & ":" & ColSalida) = ""
Range(ColSalida & "1") = "MACRO"
Macro = 5
Range(ColDato & Macro) = "'OPCION"
Range(ColSalida & Macro) = "'1"
Macro = Macro + 1
Range(ColDato & Macro) = "'OPCION"
Range(ColSalida & Macro) = "'25"
Macro = Macro + 1
Range(ColDato & Macro) = "'ENTER1"
Range(ColSalida & Macro) = ""
Macro = Macro + 1
'SOLICITAMOS EL NUMERO DE LINEA DEL PROCESO
Ini = 8
IniT = InputBox("Número de renglón para inicio de proceso: ", Mc, Ini)
Ini = Val(IniT)
If Ini < 8 Then
Range("A1").Select
MsgBox "Dato incorrecto", vbCritical, Mc
Exit Sub
Else
If Range("A" & Ini) = "" Then
Range("A1").Select
MsgBox "Dato incorrecto, linea en blanco.", vbCritical, Mc
Exit Sub
End If
End If
TiempoIni = Time
'REALIZAMOS LA DESCARGA DE LA INFORMACION.
Np = 0: Ntp = 0: Nr = 0: PoTotal = 0
Cblanco = 0: Camarillo = 0: Crojo = 0: Crosa = 0
Gtotal = 0
Reg = 0
LinBlanca = True
Do While Ini <= Fin
Windows.Application.StatusBar = "'REG-" & Ini - 21 & " de " & Fin - 21 & _
" Estado OK: " & Cblanco & _
" Estado suspendido: " & Camarillo & _
" Precio menor: " & Crojo & _
" Sin UPC: " & Crosa & _
" Total a surtir: " & Gtotal
If Range("A" & Ini) <> "" Then
If LinBlanca = True Then
Call LineaBlanca(Ini)
LinBlanca = False
Else
Call LineaCian(Ini)
LinBlanca = True
End If
' If Ini = 178 Then
' Ini = Ini
' End If
If Val(Range("N" & Ini)) < 0 And Trim(Range("K" & Ini)) <> "" And _
(Range("L" & Ini) = "PAGO A TERCEROS" Or Range("L" & Ini) = "TRANS. INTERBANCARIA") Then
Range("U" & Ini) = "'REG-" & Ini - 7 'REGISTRO
Range(ColReg & Macro) = "'REG-" & Ini - 7 'REGISTRO
Range(ColDato & Macro) = "'" & Range("K7") 'REFERENCIA
Range(ColSalida & Macro) = "'" & Range("K" & Ini)
Range(ColSalida2 & Macro) = "'" & Range("N" & Ini)
Macro = Macro + 1
Range(ColDato & Macro) = "'ENTER1"
Range(ColSalida & Macro) = ""
Macro = Macro + 1
Range(ColDato & Macro) = "'ENTER2"
Range(ColSalida & Macro) = ""
Macro = Macro + 1
Range(ColDato & Macro) = "'OPCION"
Range(ColSalida & Macro) = "'P"
Macro = Macro + 1
Gtotal = Gtotal + (Range("N" & Ini) * -1)
Reg = Reg + 1
Call ColorRojo(Ini)
ElseIf Val(Range("N" & Ini)) < 0 And Trim(Range("K" & Ini)) = "" And _
(Range("L" & Ini) = "PAGO A TERCEROS" Or Range("L" & Ini) = "TRANS. INTERBANCARIA") Then
Call ColorRosa(Ini)
End If
End If
Ini = Ini + 1
Loop
Range("L1") = "Posteos"
Range("M1") = Reg
Range("L2") = "Importe"
Range("M2") = Gtotal * -1
Range("L3") = "Registros"
Range("M3") = Fin
Range("BF1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.Copy
Workbooks.Add
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' ChDir "C:\"
On Error Resume Next
Windows.Application.StatusBar = "Generación finalizada. Hora inicio: " & TiempoIni & "Hora fin:" & Time
ActiveWorkbook.SaveAs Filename:=ArchSalida, FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
If Err.Number <> 0 Then
MsgBox "Generación cancelada." & vbCrLf & Err.Number & " " & Err.Description, vbInformation, Mc
ActiveWindow.Close , SaveChanges:=False
Else
ActiveWindow.Close
MsgBox "Generación finalizada." & vbCrLf & _
"Hora inicio: " & TiempoIni & vbCrLf & _
"Hora fin:" & Time, vbInformation, Mc
End If
Range("A3").Select
End Sub

Sub LimpiaColBEBF()
'
' LimpiaColBEBF Macro
'

'
' ActiveWindow.Panes(2).Activate
Columns("BB:BG").Select
Selection.ClearContents
Range("BE1").Select
End Sub

espero puedas ayudarme