Colocar Bordes con código VB

03/12/2009 - 00:34 por JForero | Informe spam
Buenas tardes grupo,



En la hoja Formulario tengo el boton Enviar, que inserta a los datos
digitados en la hoja Clientes, esto lo hago con el siguiente codigo :



Hay alguna forma para que cada vez que se de click al boton, y se inserten
los datos automáticamente me coloque bordes, utilizando la opción de bordes
"todos los bordes" que se encuentra en el menu de Excel 2007, el borde debe
ser hasta la ultima fila y columna que contenga datos



Como siempre gracias por la colaboracion

Saludos

Jorgef



Codigo:

Private Sub btnEnviar_Click()

'Desproteje hojas

Worksheets("Clientes").Unprotect ("sure")

Worksheets("Contactos").Unprotect ("sure")

Worksheets("Cotizaciones").Unprotect ("sure")

Dim iFila As Long

Dim wsCliente, wsContactos, wsCotizacion As Worksheet

If opbCrearCliente.Value = True Then

Set wsCliente = Worksheets("Clientes")

With Worksheets("Clientes")

Dim xCliente As Boolean

For Each Celda In .Range(.Range("a2"), .Range("a2").End(xlDown)).Cells

If Worksheets("Formulario").Range("c4") = Celda.Value Then

MsgBox ("Cliente ya Existe")

xCliente = True

End If

Next Celda

If xCliente = False Then

'Encuentra la siguiente fila vacia

iFila = wsCliente.Cells(Rows.Count, 1).End(xlUp).Offset(1,
0).Row

'Copia los datos a la hoja Clientes Eligiendo Clientes

wsCliente.Cells(iFila, 1).Value =
Worksheets("Formulario").Range("c4")

wsCliente.Cells(iFila, 2).Value =
UCase(Worksheets("Formulario").Range("c5"))

wsCliente.Cells(iFila, 3).Value = Me.cmbActivo.Value

wsCliente.Cells(iFila, 4).Value =
Worksheets("Formulario").Range("c6")

wsCliente.Cells(iFila, 5).Value =
UCase(Worksheets("Formulario").Range("e6"))

wsCliente.Cells(iFila, 6).Value =
UCase(Worksheets("Formulario").Range("c7"))

wsCliente.Cells(iFila, 7).Value =
Worksheets("Formulario").Range("e7")

wsCliente.Cells(iFila, 8).Value =
Worksheets("Formulario").Range("g7")

End If

End With

End If

End sub

Preguntas similare

Leer las respuestas

#1 Héctor Miguel
05/12/2009 - 07:48 | Informe spam
hola, Jorge !

En la hoja Formulario tengo el boton Enviar, que inserta a los datos... en la hoja Clientes... con el siguiente codigo:
Hay alguna forma para que cada vez que se de click al boton, y se inserten los datos automáticamente me coloque bordes
utilizando la opcion de bordes "todos los bordes" que se encuentra en el menu de Excel 2007 ...



comentarios previos (por si fueran de utilidad)...

1) en esta linea de tu codigo: > Dim wsCliente, wsContactos, wsCotizacion As Worksheet
a) wsCliente y wsContactos son variables de tipo "Variant" (por omision ya que NO lo estableces explicitamente)
b) wsCotizacion es la unica variable de tipo "Worksheet" (esta explicitamente declarada como tal)

2) no veo el "sentido" de esta linea: > Set wsCliente = Worksheets("Clientes")
si en la linea siguiente utilizas: > With Worksheets("Clientes")
en lugar de: With wsCliente (?????)

3) (creo que) puedes evitar el bucle (For Each Celda In ...) haciendo un "conteo directo" con la funcion contar.si (por codigo)

prueba con las siguientes adaptaciones (la parte mas larga es la adicion de los bordes) y...
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Private Sub btnEnviar_Click()
Dim wsForm As Worksheet
If Not opbCrearCliente Then Exit Sub
With Worksheets("clientes")
If Application.CountIf(.Range(.Range("a2"), .Range("a2").End(xlDown)), _
Worksheets("Formulario").Range("c4")) Then MsgBox "Cliente ya existe !!!": Exit Sub
Set wsForm = Worksheets("formulario")
.Unprotect "sure"
With .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 8)
.Value = Array(wsForm.Range("c4"), UCase(wsForm.Range("c5")), Me.cmbActivo, _
wsForm.Range("c6"), UCase(wsForm.Range("e6")), UCase(wsForm.Range("c7")), _
wsForm.Range("e7"), wsForm.Range("g7"))
.Borders(xlDiagonalDown).LineStyle = xlNone: .Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With
With .Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With
With .Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With
With .Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With
With .Borders(xlInsideVertical): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With
With .Borders(xlInsideHorizontal): .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin: End With
End With
Set wsForm = Nothing
.Protect "sure"
End With
End Sub

__ el codigo expuesto __
Private Sub btnEnviar_Click()
'Desproteje hojas
Worksheets("Clientes").Unprotect ("sure")
Worksheets("Contactos").Unprotect ("sure")
Worksheets("Cotizaciones").Unprotect ("sure")
Dim iFila As Long
Dim wsCliente, wsContactos, wsCotizacion As Worksheet
If opbCrearCliente.Value = True Then
Set wsCliente = Worksheets("Clientes")
With Worksheets("Clientes")
Dim xCliente As Boolean
For Each Celda In .Range(.Range("a2"), .Range("a2").End(xlDown)).Cells
If Worksheets("Formulario").Range("c4") = Celda.Value Then
MsgBox ("Cliente ya Existe")
xCliente = True
End If
Next Celda
If xCliente = False Then
'Encuentra la siguiente fila vacia
iFila = wsCliente.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'Copia los datos a la hoja Clientes Eligiendo Clientes
wsCliente.Cells(iFila, 1).Value = Worksheets("Formulario").Range("c4")
wsCliente.Cells(iFila, 2).Value = UCase(Worksheets("Formulario").Range("c5"))
wsCliente.Cells(iFila, 3).Value = Me.cmbActivo.Value
wsCliente.Cells(iFila, 4).Value = Worksheets("Formulario").Range("c6")
wsCliente.Cells(iFila, 5).Value = UCase(Worksheets("Formulario").Range("e6"))
wsCliente.Cells(iFila, 6).Value = UCase(Worksheets("Formulario").Range("c7"))
wsCliente.Cells(iFila, 7).Value = Worksheets("Formulario").Range("e7")
wsCliente.Cells(iFila, 8).Value = Worksheets("Formulario").Range("g7")
End If
End With
End If
End sub
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaRespuesta Tengo una respuesta
Search Busqueda sugerida