hola amigos tengo este formulario ado con control con acces
Subefotos.com - Comparte rapidamente tus fotos
este formulario me funciona todo excepto la imagen, lo que quiero en mi mantenimiento es que cuando ingreso a un nuevo cliente, tambien pueda subirle la foto y grabarla.
solamente he conseguido subir la foto pèro no se el codigo para que se guarde, lo que no quiero es que se guarde en la base de datos sino seria muy pesado, tengo un ejemplo exactamente igual pero esta en ado full codigo y yo quiero hacerlo en ado con el control, les adjunto mi codificacion
------------------------------------------------------------------------------------------------------------
Option Explicit
Private mintCurFrame As Integer ' Marco activo visible
Public Enum botonesbarraherra
separadorbarra = 1
nuevoregbarra
editarregbarra
grabarregbarra
eliminarregbarra
cancelarbarra
refrescarbarra
buscarregbarra
imprimirregbarra
End Enum
Private Sub autor_Click()
frmSplash.Show vbModal, Me
End Sub
Private Sub Command2_Click()
CentrarFormulario
Dim buscando1 As String, Criterio1 As String
buscando1 = InputBox("¿Que empresa quieres buscar?")
If buscando1 = "" Then Exit Sub
Criterio1 = "Empresas Like '*" & buscando1 & "*'"
'Buscar desde el siguiente registro a la posoción actual
Adodc1.Recordset.MoveNext
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.Find Criterio1
End If
If Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveFirst
' Buscar desde el principio
Adodc1.Recordset.Find Criterio1
If Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
MsgBox ("No encuentro esa empresa")
End If
End If
End Sub
Private Sub Command3_Click()
Form3.Show
End Sub
Private Sub Form_Load()
mintCurFrame = TabStrip1.SelectedItem.Index
fechanac.Enabled = False
DTPicker1.Enabled = False
CentrarFormulario
InhabilitarCajas
InhabilitarCombo
HabilitarBotonesBarra
Grabar.Enabled = False
Cancelar.Enabled = False
InsertarFoto.Enabled = False
HabilitarMenu
Toolbar1.Buttons(4).Enabled = False
Toolbar1.Buttons(cancelarbarra).Enabled = False
End Sub
Private Sub CentrarFormulario()
With Form1
.Width = 11200
.Height = 9000
.Left = (Screen.Width - Width) / 2
.Top = (Screen.Height - Height) / 2 - 150
End With
End Sub
Private Sub Frame4_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub Frame11_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub mnuNuevoRegistro_Click()
Nuevo_Click
End Sub
Private Sub mnuEditaRegistro_Click()
Editar_Click
End Sub
Private Sub mnuGrabaRegistro_Click()
Grabar_Click
End Sub
Private Sub mnuSalir_Click()
Salir_Click
End Sub
Private Sub mnuBorraRegistro_Click()
Borrar_Click
End Sub
Private Sub mnuBuscaRegistro_Click()
Buscar_Click
End Sub
Private Sub imprimir_Click()
DataReport1.Show
End Sub
Private Sub mnuAcercaAgenda_Click()
frmAbout.Show vbModal, Me
End Sub
Private Sub TabStrip1_Click()
If TabStrip1.SelectedItem.Index = mintCurFrame Then
Exit Sub ' No necesita cambiar el marco.
End If
' Oculte el marco antiguo y muestre el nuevo.
Frame1(TabStrip1.SelectedItem.Index).Visible = True
Frame1(mintCurFrame).Visible = False
' Establece mintCurFrame al nuevo valor.
mintCurFrame = TabStrip1.SelectedItem.Index
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "nuevoregbarra"
Nuevo_Click
Case "editarregbarra"
Editar_Click
Case "grabarregbarra"
Grabar_Click
Case "eliminarregbarra"
Borrar_Click
Case "cancelarbarra"
Cancelar_Click
Case "refrescarbarra"
Refrescar_Click
Case "buscarregbarra"
Buscar_Click
Case "imprimirregbarra"
DataReport1.Show
End Select
End Sub
Private Sub DehabilitarMenu()
mnuGrabaRegistro.Enabled = True
mnuNuevoRegistro.Enabled = False
mnuEditaRegistro.Enabled = False
mnuEliminaRegistro.Enabled = False
mnuBuscarRegistro.Enabled = False
End Sub
Private Sub HabilitarMenu()
mnuGrabaRegistro.Enabled = False
mnuNuevoRegistro.Enabled = True
mnuEditaRegistro.Enabled = True
mnuEliminaRegistro.Enabled = True
mnuBuscarRegistro.Enabled = True
End Sub
Private Sub InhabilitarBotonesBarra()
Dim n As Integer
For n = nuevoregbarra To imprimirregbarra
Toolbar1.Buttons(n).Enabled = False
Next n
End Sub
Private Sub HabilitarBotonesBarra()
Dim n As Integer
For n = nuevoregbarra To imprimirregbarra
Toolbar1.Buttons(n).Enabled = True
Next n
End Sub
Private Sub InhabilitarCajas()
Dim n As Integer
For n = 0 To Controls.Count - 1
'If el control es una caja de texto, inhabilitarla
If TypeOf Controls(n) Is TextBox Then
Controls(n).Enabled = False
End If
Next n
End Sub
Private Sub HabilitarCajas()
Dim n As Integer
For n = 0 To Controls.Count - 1
If TypeOf Controls(n) Is TextBox Then
Controls(n).Enabled = True
End If
Next n
End Sub
Private Sub InhabilitarCombo()
Dim n As Integer
For n = 0 To Controls.Count - 1
If TypeOf Controls(n) Is ComboBox Then
Controls(n).Enabled = False
End If
Next n
End Sub
Private Sub HabilitarCombo()
Dim n As Integer
For n = 0 To Controls.Count - 1
If TypeOf Controls(n) Is ComboBox Then
Controls(n).Enabled = True
End If
Next n
End Sub
Private Sub InhabilitarBotones()
Dim n As Integer
For n = 0 To Controls.Count - 1
If TypeOf Controls(n) Is CommandButton Then
Controls(n).Enabled = False
End If
Next n
End Sub
Private Sub HabilitarBotones()
Dim n As Integer
For n = 0 To Controls.Count - 1
If TypeOf Controls(n) Is CommandButton Then
Controls(n).Enabled = True
End If
Next n
End Sub
Private Sub Nombre_KeyPress(KeyAscii As Integer)
' If KeyAscii = 13 Then rut.SetFocus
End Sub
Private Sub rut_KeyPress(KeyAscii As Integer)
' If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 13 Then
' If KeyAscii = 13 Then dv.SetFocus
' Else
' KeyAscii = 0
' End If
End Sub
Private Sub dv_KeyPress(KeyAscii As Integer)
' If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 75 Or KeyAscii = 13 _
' Or KeyAscii = 107 Or KeyAscii = 8 Then
' If KeyAscii = 13 Then sexo.SetFocus
' Else
' KeyAscii = 0
'End If
End Sub
Private Sub sexo_KeyPress(KeyAscii As Integer)
' If KeyAscii = 13 Then
' fechanac.SetFocus
' Else
' KeyAscii = 0
'End If
End Sub
Private Sub InsertarFoto_Click()
cd.Action = 1
foto.Picture = LoadPicture(cd.FileName)
cd.Filter = "Imágenes|*.bmp;*.ico;*.JPEG;|Todos los archivos|*.*"
'dialogo.DialogTitle = " Seleccionar imagen para grabar en campo OLE "
'
' dialogo.ShowOpen
' If dialogo.FileName = "" Then Exit Sub
'Crea un nuevo registro con el método AddNew
'Adodc1.Recordset.AddNew
' Carga el gráfico seleccionado en el control Picture y al estar enlazado _
se almacena e el campo imagenes
'Picture1.Picture = LoadPicture(dialogo.FileName)
'dialogo.ShowOpen
'Picture1.Picture = LoadPicture(dialogo.FileName)
' Picture1.Picture = LoadPicture("C:\imagen.jpg")
' MsgBox ("Lo siento, este módulo está en Construcción"), vbOKOnly + vbInformation, "Modulo en Construccion!"
End Sub
Private Sub fechanac_KeyPress(KeyAscii As Integer)
' If KeyAscii = 13 Then direccion.SetFocus
End Sub
Private Sub direccion_KeyPress(KeyAscii As Integer)
' If KeyAscii = 13 Then fono.SetFocus
End Sub
Private Sub fono_KeyPress(KeyAscii As Integer)
' If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 13 Then
' If KeyAscii = 13 Then movil.SetFocus
' Else
' KeyAscii = 0
' End If
End Sub
Private Sub movil_KeyPress(KeyAscii As Integer)
'If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 8 Or KeyAscii = 13 Then
' If KeyAscii = 13 Then email.SetFocus
' Else
' KeyAscii = 0
' End If
End Sub
Private Sub comuna_KeyPress(KeyAscii As Integer)
' KeyAscii = 0
End Sub
Private Sub ciudad_KeyPress(KeyAscii As Integer)
' KeyAscii = 0
End Sub
Private Sub Inicio_Click()
'MoveFirst se posiciona en el Primer registro.
Adodc1.Recordset.MoveFirst
End Sub
Private Sub Anterior_Click()
'MovePrevious se posiciona en el registro Anterior.
Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF Then
Adodc1.Recordset.MoveFirst
End If
End Sub
Private Sub Siguiente_Click()
'MoveNext se posiciona en el Siguiente registro.
Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
End If
End Sub
Private Sub Final_Click()
'MoveFirst se posiciona en el Primer Ultimo registro.
Adodc1.Recordset.MoveLast
End Sub
Private Sub Nuevo_Click()
CentrarFormulario
fechanac.Enabled = True
DTPicker1.Enabled = True
Estado.Caption = "Nuevo Registro"
HabilitarCajas
HabilitarCombo
InhabilitarBotones
InhabilitarBotonesBarra
Grabar.Enabled = True
Cancelar.Enabled = True
InsertarFoto.Enabled = True
Salir.Enabled = True
Frame6.Enabled = False
HabilitarMenu
DehabilitarMenu
Toolbar1.Buttons(grabarregbarra).Enabled = True
Toolbar1.Buttons(cancelarbarra).Enabled = True
Adodc1.Recordset.AddNew 'Añadir un nuevo registro
' Nombre.SetFocus poner el cursor en la caja del nombre
End Sub
Private Sub Editar_Click()
fechanac.Enabled = True
DTPicker1.Enabled = True
CentrarFormulario
Estado.Caption = "Editando Registro"
HabilitarCajas
HabilitarCombo
InhabilitarBotones
InhabilitarBotonesBarra
Grabar.Enabled = True
Cancelar.Enabled = True
InsertarFoto.Enabled = True
Salir.Enabled = True
Frame6.Enabled = False
HabilitarMenu
DehabilitarMenu
Toolbar1.Buttons(grabarregbarra).Enabled = True
Toolbar1.Buttons(cancelarbarra).Enabled = True
End Sub
Private Sub Grabar_Click()
On Error Resume Next
CentrarFormulario
If Nombre.Text <> "" And rut.Text <> "" And dv.Text <> "" _
And sexo.Text <> "" And direccion.Text <> "" _
And fono <> "" And comuna <> "" And ciudad <> "" Then
CentrarFormulario
fechanac.Enabled = False
DTPicker1.Enabled = False
Estado.Caption = ""
Adodc1.Recordset.Update
HabilitarBotones
InhabilitarCajas
InhabilitarCombo
HabilitarBotonesBarra
HabilitarMenu
Grabar.Enabled = False
InsertarFoto.Enabled = False
Frame6.Enabled = True
Toolbar1.Buttons(grabarregbarra).Enabled = False
Else
MsgBox ("Advertencia!...Debe llenar todo los campos..."), vbInformation, "Mensaje de Seguridad "
End If
On Error Resume Next
CentrarFormulario
Adodc1.Recordset.Requery
HabilitarBotones
Grabar.Enabled = False
InsertarFoto.Enabled = False
'Actualiza el recordset
Adodc1.Recordset.Update
'Refresca el control Data
Adodc1.Refresh
End Sub
Private Sub Cancelar_Click()
On Error Resume Next
CentrarFormulario
fechanac.Enabled = False
DTPicker1.Enabled = False
Estado.Caption = ""
Adodc1.Recordset.CancelUpdate
Refrescar_Click
HabilitarBotones
Grabar.Enabled = False
InsertarFoto.Enabled = False
Frame6.Enabled = True
HabilitarMenu
InhabilitarCajas
InhabilitarCombo
HabilitarBotonesBarra
Toolbar1.Buttons(grabarregbarra).Enabled = False
End Sub
Private Sub Refrescar_Click()
On Error Resume Next
CentrarFormulario
Adodc1.Recordset.Requery
HabilitarBotones
Grabar.Enabled = False
InsertarFoto.Enabled = False
End Sub
Private Sub Borrar_Click()
CentrarFormulario
Dim r As Integer
On Error GoTo RutinaDeError
r = MsgBox("¿Desea borrar el registro?", vbInformation + vbYesNo, "Atención")
If r <> vbYes Then Exit Sub
Adodc1.Recordset.Delete 'borrar el registro actual
Adodc1.Recordset.MoveNext 'situarse en el registro siguiente
If Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
End If
Exit Sub
RutinaDeError:
r = MsgBox(Error, vbOKOnly, "Se ha producido un error:")
Adodc1.Recordset.CancelUpdate
End Sub
Private Sub Buscar_Click()
CentrarFormulario
Dim buscando As String, Criterio As String
buscando = InputBox("¿Que nombre quieres buscar?")
If buscando = "" Then Exit Sub
Criterio = "Nombre Like '*" & buscando & "*'"
'Buscar desde el siguiente registro a la posoción actual
Adodc1.Recordset.MoveNext
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.Find Criterio
End If
If Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveFirst
' Buscar desde el principio
Adodc1.Recordset.Find Criterio
If Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
MsgBox ("No encuentro ese nombre")
End If
End If
End Sub
Private Sub listado_Click()
Form2.Show
End Sub
Private Sub Timer1_Timer()
StatusBar1.Panels(3).Text = Format(Time, "hh:mm:ss")
End Sub
Private Sub Salir_Click()
Dim Salir As Integer
Salir = MsgBox("¿Esta seguro que desea salir?", vbYesNo + vbInformation, "Salir del Sistema")
If Salir = 6 Then
Unload Me
End
End If
End Sub
------------------------------------------------------------------------------------------------------------
espero me puedan ayudar muchas gracias!