Foto en formulario vba
De antemano te agradezco por leer mi pregunta, Resulta que estamos elaborando una base de datos en el colegio donde trabajo y lo estamos trabajando con el editor de visual basic y formularios.En la primera columna de la base de datos ubicamos el apellido, en la segunda el nombre, el la tercera la dirección, en la cuarta una característica y en la quinta la foto, el problema que tenemos no esta en los datos si no en la foto; no sabemos como arrastrarla con el dato principal que es el apellido. Te envío la macro que estamos utilizando para los datos hasta la cuarta columna.
Public ubica As String
Public control As Integer
Public filalibre As Integer
Private Sub cmdCancelar_Click()
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox1.SetFocus
End Sub
Private Sub TextBox1_AfterUpdate()
Sheets("BASE DE DATOS").Select
filalibre = Range("A2").End(xlDown).Offset(1, 0).Row 'la variable filalibre guarda el nro. De la primer celda vacía.
control = 0
dato = TextBox1
rango = "A2:A" & filalibre
Set midato = ActiveSheet.Range(rango).Find(dato, LookIn:=xlValues, LookAt:=xlWhole)
If Not (midato) Is Nothing Then
ubica = midato.Address(False, False)
TextBox2.Value = Range(ubica).Offset(0, 1).Value
TextBox3.Value = Range(ubica).Offset(0, 2).Value
TextBox4.Value = Range(ubica).Offset(0, 3).Value
control = 1
End If
Set midato = Nothing
End Sub
Private Sub cmdAceptar_Click()
Sheets("BASE DE DATOS").Select
If control > 0 Then
Range(ubica).Value = TextBox1
Range(ubica).Offset(0, 1).Value = TextBox2
Range(ubica).Offset(0, 2).Value = TextBox3
Range(ubica).Offset(0, 3).Value = TextBox4
control = 0
Else
Cells(filalibre, 1).Value = TextBox1
Cells(filalibre, 2).Value = TextBox2
Cells(filalibre, 3).Value = TextBox3
Cells(filalibre, 4).Value = TextBox4
End If
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox1.SetFocus
End Sub
Private Sub cmdEliminar_Click()
Sheets("BASE DE DATOS").Select
Range(ubica).EntireRow.Delete
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox1.SetFocus
End Sub
Private Sub cmdPrimero_Click()
TextBox1.Value = Range("A2").Value
TextBox1_AfterUpdate
End Sub
Private Sub cmdUltimo_Click()
TextBox1.Value = Cells(filalibre - 1, 1).Value
TextBox1_AfterUpdate
End Sub
Public ubica As String
Public control As Integer
Public filalibre As Integer
Private Sub cmdCancelar_Click()
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox1.SetFocus
End Sub
Private Sub TextBox1_AfterUpdate()
Sheets("BASE DE DATOS").Select
filalibre = Range("A2").End(xlDown).Offset(1, 0).Row 'la variable filalibre guarda el nro. De la primer celda vacía.
control = 0
dato = TextBox1
rango = "A2:A" & filalibre
Set midato = ActiveSheet.Range(rango).Find(dato, LookIn:=xlValues, LookAt:=xlWhole)
If Not (midato) Is Nothing Then
ubica = midato.Address(False, False)
TextBox2.Value = Range(ubica).Offset(0, 1).Value
TextBox3.Value = Range(ubica).Offset(0, 2).Value
TextBox4.Value = Range(ubica).Offset(0, 3).Value
control = 1
End If
Set midato = Nothing
End Sub
Private Sub cmdAceptar_Click()
Sheets("BASE DE DATOS").Select
If control > 0 Then
Range(ubica).Value = TextBox1
Range(ubica).Offset(0, 1).Value = TextBox2
Range(ubica).Offset(0, 2).Value = TextBox3
Range(ubica).Offset(0, 3).Value = TextBox4
control = 0
Else
Cells(filalibre, 1).Value = TextBox1
Cells(filalibre, 2).Value = TextBox2
Cells(filalibre, 3).Value = TextBox3
Cells(filalibre, 4).Value = TextBox4
End If
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox1.SetFocus
End Sub
Private Sub cmdEliminar_Click()
Sheets("BASE DE DATOS").Select
Range(ubica).EntireRow.Delete
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox1.SetFocus
End Sub
Private Sub cmdPrimero_Click()
TextBox1.Value = Range("A2").Value
TextBox1_AfterUpdate
End Sub
Private Sub cmdUltimo_Click()
TextBox1.Value = Cells(filalibre - 1, 1).Value
TextBox1_AfterUpdate
End Sub
1 Respuesta
Respuesta de Orlando Collarte
1