image
Inicio » Foros » ASP

ASP

Tengo un problema en mi macro

Volver al foro | Responder | Añadir nuevo tema


De: Ramiro
Fecha: 30/03/2015
Mensaje:

Por favor alguien me puede ayudar tengo un problema en mi macro es que soy nuevo en esto y no se como solucionarlo y me da else sin If y otros por fa ayuda.

Option Explicit
Global libro As String, ruta As String

Function buscar(ByRef r, cod As Long) As Boolean

On Error GoTo fin
Dim i As Integer, r1 As Integer
'compruebo si ya está abierto sino lo abro If libro_abierto(libro) = False Then

'abro el libro MiTarifa. Donde pone password, pondría la de apertura entre las comillas 'selecciono el libro y me coloco en la columna ID

Workbooks.Open FileName:=(ruta & "\" & libro), Password:=""

Range("A1").Select

Else:

'como ya esta abierto, lo activo y me coloco en la columna ID

Workbooks(libro).Activate

Range("A1").Select

End If

'con el libro y la columna seleccionada inicio la busqueda

'inicio variables

i = 0

r1 = ActiveCell.Row

Do While Cells(r1 + i, 1).Value <> cod And Cells(r1 + i, 1).Value <> ""

i = i + 1

Loop

If Cells(r1 + i, 1).Value = cod Then

'modifico la variable r para poder luego insertar

r = r1 + i

buscar = True

Exit Function

Else:

'ID no encontrado. Cierro el libro MiTarifa

Workbooks(libro).Close savechanges:=False

buscar = False

Exit Function

End If

'Caso de no encontrar el libro MiTarifa

fin:

buscar = False

End Function

Sub insertar(r, nom, desc, peso)

'me ubico en la celda Id del libro MiTarifa

Cells(r, 1).Select

'inserto los valores columna c:3, columna s:19, columna v:22

Cells(r, 3).Value = nom

Cells(r, 19).Value = peso

Cells(r, 22).Value = desc

End Sub

Function libro_abierto(libro As String) As Boolean

Dim wb As Workbook

For Each wb In Application.Workbooks

If UCase(wb.Name) = UCase(libro) Then

libro_abierto = True

Exit Function

End If

Next wb

libro_abierto = False

End Function

Sub principal()

On Error Resume Next
Dim cod As Long, peso As Integer, r As Integer

Dim nombre As String, descripcion As String

Application.ScreenUpdating = False

'asigno el ID a cod y su fila a r porque la columna es la A

cod = ActiveCell.Value

r = ActiveCell.Row

'asigno los valores de descripcion, nombre y peso

descripcion = Cells(r, 2).Value

nombre = Cells(r, 3).Value

peso = Cells(r, 4).Value

'asigno la dirección de la carpeta del libro Proveedor (que debe coincidir con MiTarifa) a ruta = ThisWorkbook.Path

'asigno el nombre del libro MiTarifa a libro

libro = "MiTarifa.xlsx"

'busco el codigo en el libro MiTarifa

If buscar(r, cod) = False Then

'si es negativo, lanzo el mensaje y abandono

MsgBox "Código no encontrado o no existe el libro " & libro, vbOKOnly + vbInformation

Exit Sub

'sino, inserto los parámetros

Else: Call insertar(r, nombre, descripcion, peso)

MsgBox "Los valores nombre, descripción y peso del código ID: " & cod & vbCrLf & _ "han sido modificados correctamente en el libro " & libro

'guardo el libro MiTarifa

Workbooks(libro).Save

End If

End Sub



Volver al foro | Responder | Añadir nuevo tema


WebEstilo.com no se hace responsable de las opiniones que los usuarios puedan verter en cualquiera de los foros existentes.

Si te solucionó el problema pulsa en G+1


Gracias!






Comparte



Última modificación:31 de Agosto de 2017. Spain - Espa�a.
© 1998-2004 por . Todos los derechos reservados.