Ver Mensaje Individual
  #7 (permalink)  
Antiguo 30/07/2008, 13:31
Avatar de A.H.H
A.H.H
 
Fecha de Ingreso: mayo-2007
Ubicación: IRUN,(GUIPUZCOA) España
Mensajes: 178
Antigüedad: 18 años
Puntos: 4
Respuesta: ayuda con visual

Hola esto es una mini agenda que hice una vez, no se si tendra algun error si eso me comentas, bueno te digo lo que tienes que usar:

Abre un proyecto nuevo exe estandar y:

En un form, dibujas un listbox y debajo un control calendar1, al lado dibujas un textbox y con sus propiedades scrollbars=3-both y ponerlo en multiline=true.

Encima del listbox puedes poner un label con el caption que diga archivos guardados.

Dibuja dos botones; un boton (command1)para eliminar cerca del listbox y otro para guardar debajo del textbox (command2) .

Copia el siguiente codigo y pegalo en el form.

el codigo:

Cita:
Public nom_arch As String
Public RUTA2 As String
Public CONTENIDO As String
Public Container As String 'variables publicas para usarlas'
Public xfecha As String 'en todo el proyecto'
Public Ruta As String

Private Sub Form_Load()

Form1.Caption = "MINIAGENDA:::Por A.H.H"
lista
Calendar1.Value = Date 'ponemos la fecha actual en el calendario'
Text1.Text = " " 'borramos el textbox'
Text1.Text = Calendar1.Value & vbCrLf
Text1.TabIndex = 0
Text1.SelStart = 10

Ruta = "C:\Agenda" 'declaramos la ruta donde se guardaran los archivos que guardemos'
If Dir(Ruta, vbDirectory) <> "" Then 'comprobamos si existe el directorio agenda'
Exit Sub
Else
MkDir (Ruta) 'si no existe se crea'
End If

xfecha = Calendar1.Value

End Sub
Private Sub Calendar1_Click()
'cada vez que hacemos click en el calendario'
'borramos el textbox y le ponemos la fecha seleccionada'

Text1.Text = " "
Text1.Text = Calendar1.Value & vbCrLf
'le mandamos leer el archivo si existe'
leer1
End Sub

Private Sub Command1_Click()
GUARDAR 'llama a la subrutina guardar'
lista 'llama a lista'
End Sub

Private Sub Command2_Click()
ELIMINAR 'llama a eliminar'
lista
End Sub

Sub escribir()
Text1.Text = " "
Text1.Text = Calendar1.Value & vbCrLf
xfecha = Calendar1.Value
Mid(xfecha, 3, 1) = " " 'esto lo hago para quitar las barras "/" de la fecha'

Mid(xfecha, 6, 1) = " " 'por que se confunde con la ruta'
'asi la variable xfecha queda con espacios sin barras'

End Sub
Sub GUARDAR()
xfecha = Calendar1.Value
Mid(xfecha, 3, 1) = " "
Mid(xfecha, 6, 1) = " "
Container = Text1.Text 'pasamos el contenido del textbox a la var container'
Open Ruta & "\" & xfecha For Output As #1
Print #1, Container 'abrimos un archivo y escribimos el contenido del textbox'
Close #1
MsgBox ("ok archivo guardado!" & vbCrLf & "en: " & Ruta & "\" & xfecha), vbExclamation, "AGENDA"
Text1.Text = " "

End Sub
Sub leer1()
xfecha = Calendar1.Value
Mid(xfecha, 3, 1) = " "
Mid(xfecha, 6, 1) = " "
If Dir(Ruta & "\" & xfecha) <> "" Then
leer2
'aqui se comprueba que exista el archivo para leer'

Else
MsgBox ("El archivo solicitado no existe!" & vbCrLf & "Debes Guardar algo para que exista."), vbExclamation, "AGENDA"
Text1.SetFocus
Exit Sub
End If
End Sub
Sub leer2()
'leemos el archivo y lo sacamos en el textbox'

Text1.Text = " "
Text1.Text = Calendar1.Value & vbCrLf


Dim n_File As Integer
Dim CONTENIDO As String
'Número de archivo libre
n_File = FreeFile

'Abre el archivo indicado
Open Ruta & "\" & xfecha For Input As n_File

'Lee todo los datos del archivo y lo almacena en la variable
CONTENIDO = Input$(LOF(n_File), #n_File)

'Cierra el archivo abierto
Close n_File

'Carga el contenido de la variable en el TextBox
Text1.Text = CONTENIDO


End Sub
Sub ELIMINAR()
Dim archivoremover As String
archivoremover = List1.Text
respuesta = MsgBox(archivoremover, vbOKCancel, "AGENDA Eliminar Archivo")

If respuesta = 1 Then
'si se pulsa aceptar en el msgbox elimina'

Kill Ruta & "\" & archivoremover

List1.Clear
Text1.Text = " "
Calendar1.Value = Date
Text1.Text = Calendar1.Value & vbCrLf
Text1.SelStart = 10
Text1.SetFocus
Else 'sino sale del sub'

Exit Sub

End If

End Sub
Sub lista()

List1.Clear
Ruta = "C:\Agenda"
RUTA2 = Ruta & "\*.*"

nom_arch = Dir(RUTA2, vbfile)

Do While nom_arch <> ""
List1.AddItem (nom_arch)
If nom_arch = "" Then Exit Do
nom_arch = Dir
Loop

End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub

Private Sub List1_Click()
xfecha = List1.Text 'para que se vea el archivo al seleccionar'
leer2 'desde el listbox'
Calendar1.Value = xfecha
End Sub
Nota:
si tienes otras rutas cambialas en el codigo como por ejemplo el disco duro, porque lo he puesto como si el disco fuera C:\
Lo que no pude conseguir era que mostrara de otro color en el calendario donde existian archivos,por eso puse un lisbox para que mostrara los archivos guardados y puedas eliminarlos desde alli tambien,tambien cuando haces click con el cursor en una fecha, mira si existe o no.
salu2 espero te sirva

Última edición por A.H.H; 03/08/2008 a las 07:06