Ayuda con tus Tareas » VB http://ayuda.fotopex.com En forma fácil Sat, 04 Sep 2010 16:22:03 +0000 en hourly 1 http://wordpress.org/?v=3.1-alpha Crear un formulario flotante dentro de otro http://ayuda.fotopex.com/programacion/vb/crear-un-formulario-flotante-dentro-de-otro/ http://ayuda.fotopex.com/programacion/vb/crear-un-formulario-flotante-dentro-de-otro/#comments Thu, 24 Apr 2008 02:16:33 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/crear-un-formulario-flotante-dentro-de-otro/ formulario-dentro-otro.JPG

Por ahí encontré un ejemplo en VB 6.0 de como llamar datos de un formulario desplegando automáticamente dentro de otro.

floppy.jpg
Clic para descargar el archivo

]]> http://ayuda.fotopex.com/programacion/vb/crear-un-formulario-flotante-dentro-de-otro/feed/ 1 Cómo eliminar una tabla de una base de datos con Visual Basic http://ayuda.fotopex.com/programacion/vb/como-eliminar-una-tabla-de-una-base-de-datos-con-visual-basic/ http://ayuda.fotopex.com/programacion/vb/como-eliminar-una-tabla-de-una-base-de-datos-con-visual-basic/#comments Mon, 24 Mar 2008 19:27:16 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/como-eliminar-una-tabla-de-una-base-de-datos-con-visual-basic/ Cuando elimina una tabla, también se eliminan todos los datos almacenados en aquella tabla. Si desea conservar los datos de la tabla, va a eliminar, escribir una aplicación Visual Basic con la que copia los datos a una tabla nueva antes de eliminar la tabla existente.

Primer Ejemplo

Texto Plano
Visual Basic:
  1. Function BorraTablaTemp()
  2.  
  3.   Dim DataBaseName, TableName As String
  4.   Dim DB As Database, t As TableDef
  5.   Dim TableExists As Boolean
  6.  
  7.   DataBaseName = App.Path & "\data.mdb"
  8.   TableName = "tmpTabla"
  9.  
  10.   On Error GoTo errorhandler
  11.   Set DB = Workspaces(0).OpenDatabase(DataBaseName)
  12.   On Error Resume Next
  13.  
  14.   Set t = DB.TableDefs(TableName)
  15.   TableExists = Err.Number = 0
  16.  
  17.   If TableExists Then
  18.     DB.Execute "Drop Table " & TableName
  19.   End If
  20.  
  21.   DB.Close
  22.  
  23.   Exit Function
  24.  
  25. errorhandler:
  26.  
  27.   Err.Raise Err.Number
  28.   Exit Function
  29.  
  30. End Function

Segundo Ejemplo:
hacemos una copia de la base de datos para borrar la tabla del ejemplo.

Texto Plano
Visual Basic:
  1. Function BorraTablaTemp()
  2.   Dim sourcedb  as string
  3.   Dim destdb as string
  4.  
  5.   On Error Resume Next
  6.   sourcedb = "c:\VB3\BIBLIO.MDB"  ' Base Original
  7.   destdb = "C:\TEST.MDB"     ' Base que utilizaremos para el ejemplo
  8.   FileCopy sourcedb, destdb  ' Hacemos la copia
  9.  
  10.   Dim db As Connection
  11.   Set db = New Connection
  12.   db.CursorLocation = adUseClient
  13.   db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & destdb & ";"
  14.   db.Execute "Drop Table tmpTabla"
  15. End Function

Tercer Ejemplo:
Genera un Recordset y recorre tabla por tabla hasta encontrar la que deseamos borrar.

Texto Plano
Visual Basic:
  1. Function BorraTablaTemp()
  2.     Dim cn As New ADODB.Connection
  3.     Dim rs As ADODB.Recordset
  4.     Dim sql As String
  5.    
  6.     cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;" & "Persist Security Info=False;" & _
  7.         "Data Source=" & App.Path & "\data.mdb"
  8.  
  9.     Set rs = cn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE"))
  10.     Do While Not rs.EOF
  11.         If rs!TABLE_NAME = "tmpTabla" Then
  12.             sql = "DROP TABLE " & rs!TABLE_NAME
  13.             cn.Execute sql, , adCmdText
  14.             Exit Do
  15.         End If
  16.         rs.MoveNext
  17.     Loop
  18. End Function

]]> http://ayuda.fotopex.com/programacion/vb/como-eliminar-una-tabla-de-una-base-de-datos-con-visual-basic/feed/ 0 La sentencia If…Then…Else http://ayuda.fotopex.com/programacion/vb/la-sentencia-ifthenelse/ http://ayuda.fotopex.com/programacion/vb/la-sentencia-ifthenelse/#comments Sun, 27 Jan 2008 17:08:57 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/la-sentencia-ifthenelse/

Referencia del Lenguaje Visual Basic

If…Then…Else (Instrucciones)
Ejecuta de forma condicional un grupo de instrucciones, dependiendo del valor de una expresión.

If condition [ Then ]
[ statements ]
[ ElseIf elseifcondition [ Then ]
[ elseifstatements ] ]
[ Else
[ elsestatements ] ]
End If

O bien

If condition Then [ statements ] [ Else elsestatements ]

condition
Requerido. es una expresion que debe evaluarse como True o False, o como un tipo de datos que sea implícitamente convertible a Boolean.

statements
Opcional en formato de múltiples líneas; se requiere en formato de una sola línea que no tenga una cláusula Else. Se ejecutan una o más instrucciones que siguen a If…Then si condition es True.

elseifcondition
Requerido si está presente ElseIf. Igual que condition.

elseifstatements
Opcional. Se ejecutan una o más instrucciones que siguen a ElseIf…Then si la elseifcondition asociada es True.

elsestatements
Opcional en formato de múltiples líneas; se requiere en formato de una sola línea que tenga una cláusula Else. Una o más instrucciones que se ejecuten si ninguna de las expresiones anteriores condition o elseifcondition es True.

End If
Termina un bloque If…Then.

Comentarios
Puede utilizar la forma de una sola línea para pruebas cortas y sencillas. Sin embargo, el formato de múltiples líneas proporciona más estructura y flexibilidad que el formato de una sola línea y, generalmente, es más fácil de leer, mantener y depurar.

Con el formato de una sola línea, es posible ejecutar varias instrucciones como resultado de una decisión If…Then. Todas las instrucciones deben estar en la misma línea y separadas por dos puntos, como en el ejemplo siguiente:

If A > 10 Then A = A + 1 : B = B + A : C = C + B

En el formato de múltiples líneas, la instrucción If debe ser la única instrucción en la primera línea.

Las instrucciones Else, ElseIf y End If pueden ir precedidas solamente por una etiqueta de línea.
La instrucción If…Then…Else de varias líneas debe finalizar con una instrucción End If.

Para determinar si una instrucción If introduce un formato de múltiples líneas, examine lo que sigue a la palabra clave Then. Si aparece cualquier otra cosa que no sea un comentario después de Then en la misma instrucción, ésta se trata como una instrucción If de una sola línea. Si Then no está definida, debe ser el comienzo de una instrucción If…Then…Else de múltiples líneas.

Las cláusulas ElseIf y Else son opcionales. Puede tener tantas cláusulas ElseIf como desee en una instrucción If…Then…Else de múltiples líneas, pero no puede aparecer ninguna después de una cláusula Else.

Los formatos de múltiples líneas pueden anidarse unos dentro de otros.

Cuando se encuentra una If…Then…Else de múltiples líneas, se prueba condition. Si condition es True, se ejecutan las instrucciones que están a continuación de Then. Si condition es False, se evalúa cada instrucción ElseIf en orden. Cuando se encuentra una elseifcondition True, se ejecutan las instrucciones que siguen inmediatamente a la instrucción Then asociada. Si
ninguna elseifcondition se evalúa como True, o no existen instrucciones ElseIf, se ejecutan las instrucciones que siguen a Else.
Después de la ejecución de las instrucciones que siguen a Then, ElseIf o Else, la ejecución continúa con la instrucción que sigue a End If.

Sugerencia
Select…Case puede ser más útil cuando se evalúa una única expresión que tiene varios valores posibles.

Ejemplo:
En este ejemplo se muestran los formatos de múltiples líneas y de una sola línea de la instrucción If…Then…Else.

Texto Plano
Visual Basic:
  1. Dim Number, Digits As Integer
  2. Dim MyString As String
  3. Number = 53 'Initialize variable.
  4. If Number <10 Then
  5.    Digits = 1
  6. ElseIf Number <100 Then ' la condición evalua a verdadero entonces la instruccion es ejecutada.
  7.    Digits = 2
  8. Else
  9.    Digits = 3
  10. End If
  11.  
  12. 'Asignamos el valor usando una simple linea.
  13.  
  14. If Digits = 1 Then MyString = "Uno" Else MyString = "Mas que uno"
  15.  
  16. 'Puede utilizar la palabra clave TypeOf para determinar si el
  17. 'objeto Control que se pasa a un procedimiento es un cuadro de texto.
  18.  
  19. Sub ControlProcessor(ByVal MyControl As Control)
  20.     If TypeOf MyControl Is ComboBox Then
  21.          Debug.WriteLine ("You passed in a " & TypeName(MyControl))
  22.     ElseIf TypeOf MyControl Is CheckBox Then
  23.          Debug.WriteLine ("You passed in a " & TypeName(MyControl))
  24.     ElseIf TypeOf MyControl Is TextBox Then
  25.          Debug.WriteLine ("You passed in a " & TypeName(MyControl))
  26.     End If
  27. End Sub

]]> http://ayuda.fotopex.com/programacion/vb/la-sentencia-ifthenelse/feed/ 6 Selección múltiple de archivos VB6 http://ayuda.fotopex.com/programacion/vb/seleccion-multiple-de-archivos-vb6/ http://ayuda.fotopex.com/programacion/vb/seleccion-multiple-de-archivos-vb6/#comments Wed, 23 Jan 2008 22:39:42 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/seleccion-multiple-de-archivos-vb6/ Components. También [...]]]> En este ejemplo al seleccionar varios archivos los mismos se copiaran a una carpeta específica, pero antes verificará si ya existen.

Vamos crear un nuevo proyecto y colocaremos un control Commondialog y un botón.

formulario.png

Ahora debemos de agregar al proyecto el control Microsoft Commond Dialog. Dando un clic en el menú Proyect > Components.

control-commond-dialog.png

También debemos de agregar la referencia Microsoft Scripting Runtime, la cual la encontraremos en el mismo men&uacte; Proyect.

referencias-scripting-runtime.png

Y finalmente el código y sus comentarios.

Texto Plano
Visual Basic:
  1. 'Api para copiar Archivos
  2.   Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
  3.   (ByVal lpExistingFileName As String, ByVal lpNewFileName _
  4.   As String, ByVal bFailIfExists As Long) As Long
  5.  
  6. Public Function FileExists(sFullPath As String) As Boolean
  7. 'Verifica si existe un archivo
  8. 'Debemos de Activar
  9. 'Microsoft Scripting Runtime en las Referencias de Visual Basic.
  10.     Dim oFile As New Scripting.FileSystemObject
  11.     FileExists = oFile.FileExists(sFullPath)
  12. 'Regresa Falso o Verdadero
  13. End Function
  14.  
  15.  
  16. Private Sub Command1_Click()
  17. On Error GoTo TrataError
  18.     'Decalramos el Array din&aacute;mico de tipo String
  19.     Dim Archivos() As String
  20.     Dim i As Long, flag As String
  21.    
  22.     With CommonDialog1
  23.         .CancelError = True ' con esto se le dice al Visual Basic que si se pulsa en Cancelar
  24.         .MaxFileSize = 32760
  25.         .FileName = ""
  26.         .DialogTitle = "Selecci&oacute;n Multiple "
  27.         .Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer
  28.         .ShowOpen
  29.     End With
  30.          
  31.     'Guardamos en el array din&aacute;mico los archivos con la funci&oacute;n Split
  32.     'indicandole como separador el Chr(0)
  33.     Archivos = Split(CommonDialog1.FileName, Chr(0))
  34.        
  35.     'Recorremos el Array e imprimimos el resultado en el formulario
  36.       For i = 0 To UBound(Archivos)
  37.         Dim RutaArchivo
  38.         Dim pos
  39.        
  40.         RutaArchivo = Archivos(i) 'Asignamos el nombre del archivo
  41.         Do 'Extraemos el Nombre de la ruta completa
  42.             pos = InStr(RutaArchivo, "\")
  43.             RutaArchivo = Mid(RutaArchivo, pos + 1, Len(RutaArchivo))
  44.         Loop Until pos = 0
  45.        
  46.         'Verificamos si no existe
  47.         If (FileExists("C:\Temp\" & RutaArchivo)) = True Then
  48.             MsgBox "Archivo " & "C:\Temp\" & RutaArchivo & " ya existe"
  49.         Else
  50.             CopyFile Archivos(i), "C:\Temp\" & RutaArchivo, True
  51.             DoEvents
  52.         End If
  53.       Next i
  54.      
  55.     'Eliminamos el array "Archivos"
  56.     Erase Archivos
  57. Exit Sub
  58.    
  59. TrataError:
  60.     If Err.Number = 32755 Then
  61.         MsgBox "El proceso se Cancelo"
  62.         Err.Clear
  63.         Exit Sub
  64.     End If
  65. End Sub

floppy.jpg
Clic para descargar el archivo
]]> http://ayuda.fotopex.com/programacion/vb/seleccion-multiple-de-archivos-vb6/feed/ 0 Convertir entre RGB, Hex y Color en Visual Basic http://ayuda.fotopex.com/programacion/vb/convertir-entre-rgb-hex-y-color-en-visual-basic/ http://ayuda.fotopex.com/programacion/vb/convertir-entre-rgb-hex-y-color-en-visual-basic/#comments Wed, 23 Jan 2008 22:19:05 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/convertir-entre-rgb-hex-y-color-en-visual-basic/ colores_vb.jpg

Como primer paso necesitamos un formulario con, 5 cajas de texto y 4 botones de comando.
También puedes encontrar un ejecutable al final del artículo.

El artículo es muy simple, pues como siempre el primer paso es entender el procedimiento y ya después te encargaras de adaptarlo a tus necesidades.

Botón cmdhextorgb.

Tomará el contenido de la caja de texto Text1 el cual debe ser de 7 caracteres #FFCC00

Texto Plano
Visual Basic:
  1. Private Sub cmdhextorgb_Click()
  2.     '#FFCC00
  3.     hexcolor = Text1.Text
  4.     Dim r, g, b As Byte
  5.     r = CByte("&H" & Mid(hexcolor, 2, 2))
  6.     g = CByte("&H" & Mid(hexcolor, 4, 2))
  7.     b = CByte("&H" & Mid(hexcolor, 6, 2))
  8.    
  9.     txtResult.BackColor = RGB(r, g, b)
  10.     txtResult.Text = r & "," & g & "," & b
  11. End Sub

Botón cmdrgbtohex.

Tomará el contenido de la caja de texto Text2 el cual debe ser separado por comas 255,255,255

Texto Plano
Visual Basic:
  1. Private Sub cmdrgbtohex_Click()
  2.     Dim num(0 To 3)
  3.     Dim pos1, pos2
  4.     RGB_Color = Text2.Text
  5.      '255,255,255
  6.     contador = 1
  7.     Do
  8.         pos1 = InStr(RGB_Color, ",")
  9.         If pos1 = 0 Then
  10.             num(contador) = (RGB_Color)
  11.         Else
  12.             num(contador) = Mid(RGB_Color, 1, pos1 - 1)
  13.         End If
  14.         RGB_Color = Mid(RGB_Color, pos1 + 1, Len(RGB_Color))
  15.         contador = contador + 1
  16.     Loop Until pos1 = 0
  17.    
  18.     r = Val(num(1))
  19.     g = Val(num(2))
  20.     b = Val(num(3))
  21.     txtResult.BackColor = RGB(r, g, b)
  22.    
  23.  
  24.     'get the r value
  25.     If r <16 Then hex1 = 0 & Hex(r) Else hex1 = Hex(r)
  26.     'get the g value
  27.     If r <16 Then hex2 = 0 & Hex(g) Else hex2 = Hex(g)
  28.     'get the b value
  29.     If b <16 Then hex3 = 0 & Hex(b) Else hex3 = Hex(b)
  30.    
  31.     txtResult.Text = "#" & hex1 & hex2 & hex3
  32. End Sub

Botón cmdrgbtocolor.

Tomará el contenido de la caja de texto Text3 el cual debe ser separado por comas 255,255,255

Texto Plano
Visual Basic:
  1. Private Sub cmdrgbtocolor_Click()
  2.     Dim num(0 To 3)
  3.     Dim pos1, pos2
  4.     RGB_Color = Text3.Text
  5.     '255,255,255
  6.     contador = 1
  7.     Do
  8.         pos1 = InStr(RGB_Color, ",")
  9.         If pos1 = 0 Then
  10.             num(contador) = (RGB_Color)
  11.         Else
  12.             num(contador) = Mid(RGB_Color, 1, pos1 - 1)
  13.         End If
  14.         RGB_Color = Mid(RGB_Color, pos1 + 1, Len(RGB_Color))
  15.         contador = contador + 1
  16.     Loop Until pos1 = 0
  17.    
  18.     txtResult.BackColor = RGB(Val(num(1)), Val(num(2)), Val(num(3)))
  19.     rgbtocolor = Val(num(1)) + (Val(num(2)) * 256) + (Val(num(3)) * 65536)
  20.    
  21.     txtResult.Text = rgbtocolor
  22. End Sub

Botón cmdcolortorgb.

Y finalmente de Color a RGB.

Texto Plano
Visual Basic:
  1. Private Sub cmdcolortorgb_Click()
  2.     mcolor = Val(Text4.Text)
  3.     Dim r, g, b As Byte
  4.     r = mcolor And 255
  5.     g = (mcolor \ 256) And 255
  6.     b = (mcolor \ 65536) And 255
  7.     colortorgb = r & "," & g & "," & b
  8.     txtResult.BackColor = RGB(r, g, b)
  9.     txtResult.Text = colortorgb
  10. End Sub

 

floppy.jpg
Clic para descargar el archivo
]]> http://ayuda.fotopex.com/programacion/vb/convertir-entre-rgb-hex-y-color-en-visual-basic/feed/ 0 Copiar archivos incluyendo subdirectorios como xcopy /s http://ayuda.fotopex.com/programacion/vb/copiar-archivos-incluyendo-subdirectorios-como-xcopy-s/ http://ayuda.fotopex.com/programacion/vb/copiar-archivos-incluyendo-subdirectorios-como-xcopy-s/#comments Wed, 23 Jan 2008 22:12:49 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/copiar-archivos-incluyendo-subdirectorios-como-xcopy-s/

Este ejemplo puede ser utilizado para crear un respaldo de archivos incluyendo los subdirectorios como xcopy /s

Primero necesitamos un formulario con 3 cajas de texto, dos etiquetas, 3 botones de comando y un checkbox

A una etiqueta le colocaremos el caption como Origen y su caja de texto la llamaremos txtOrigen
La segunda etiqueta será Destino y su caja de texto txtDestino
La tercera caja de texto será txtInfo
Al primer botón de comando le llamaremos cmdOrigen y su caption Seleccionar
Al segundo botón de comando le llamaremos cmdDestino y su caption Seleccionar
Al tercer botón de comando le llamaremos cmdCopiar y su caption Copiar

Así es como se debe ver el formulario

xcopy_vb6.jpg

Ahora las funciones

Damos doble clic sobre el formulario y creamos la función CopyFiles, que será para lo mismo.

Texto Plano
Visual Basic:
  1. Option Explicit
  2. Private Sub Form_Load()
  3.  
  4. End Sub
  5.  
  6. Function CopyFiles(srcPath As String, dstPath As String, IncludeSubDirs As Integer, FilePat As String) As Integer
  7.  
  8. ' Esta rutina copia todos los archivos de un directorio
  9. ' incluyendo los subdirectorios, Como XCOPY /S
  10.  
  11.     Const ATTR_DIRECTORY = 16
  12.    
  13.     Dim DirOK As Integer, i As Integer
  14.     Dim DirReturn As String
  15.     ReDim d(100) As String
  16.     Dim dCount As Integer
  17.     Dim CurrFile$
  18.     Dim CurrDir$
  19.     Dim dstPathBackup As String
  20.     Dim f%
  21.  
  22.    On Error GoTo DirErr
  23.  
  24.    CurrDir$ = CurDir$ ' directorio actual de trabajo
  25.    srcPath = UCase$(srcPath)
  26.    dstPath = UCase$(dstPath)
  27.  
  28.    dstPathBackup = dstPath ' guardamos el directorio destino
  29.    
  30.    ' Iniciamos variables para mantener los nombres de archivos
  31.    DirReturn = Dir(srcPath & "*.*", ATTR_DIRECTORY)
  32.    
  33.    ' Buscamos todos los Subdiectorios
  34.    Do While DirReturn <> ""
  35.       ' aseguramos que no se haga nada con "." y ".."
  36.       If DirReturn <> "." And DirReturn <> ".." Then
  37.          If (GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
  38.             ' agregamos a la lista de directorios
  39.             dCount = dCount + 1
  40.             d(dCount) = srcPath & DirReturn
  41.          End If
  42.       End If
  43.       DirReturn = Dir
  44.    Loop
  45.    
  46.    ' ahora hacemos que los archivos que coicidan
  47.    DirReturn = Dir(srcPath & FilePat, 0)
  48.  
  49.    ' Buscamos todos los archivos
  50.    Do While DirReturn <> ""
  51.       ' aseguramos que no es directorio
  52.       If Not ((GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY) Then
  53.          ' es un archivo y se copia
  54.          frmMain!txtInfo.Text = txtInfo.Text & vbCrLf & "Copiando " & srcPath & DirReturn & " a " & dstPath & DirReturn
  55.          frmMain!txtInfo.Refresh
  56.          'Si existe preguntamos si se sobre-escribe
  57.          On Error Resume Next
  58.          f% = FreeFile
  59.          Open dstPath & DirReturn For Input As #f%
  60.          Close #f%
  61.          If Err = 0 Then
  62.             f% = MsgBox("El archivo " & dstPath & DirReturn & " ya existe. Desea sobre-escribirlo ?", 4 + 32 + 256)
  63.             If f% = 6 Then FileCopy srcPath & DirReturn, dstPath & DirReturn
  64.          Else
  65.             FileCopy srcPath & DirReturn, dstPath & DirReturn
  66.          End If
  67.       End If
  68.       DirReturn = Dir
  69.    Loop
  70.  
  71.    ' Ahora hacemos los subdirectorios
  72.    For i = 1 To dCount
  73.       If IncludeSubDirs Then
  74.          On Error GoTo PathErr
  75.          dstPath = dstPath & Right$(d(i), Len(d(i)) - Len(srcPath))
  76.          ' si el path no existe lo creamos
  77.          ChDir dstPath
  78.          On Error GoTo DirErr
  79.       Else
  80.          CopyFiles = True
  81.          GoTo ExitFunc
  82.       End If
  83.       DirOK = CopyFiles(d(i), dstPath, IncludeSubDirs, FilePat)
  84.       ' Reiniciamos dstPath al valor asignado
  85.       dstPath = dstPathBackup
  86.    Next
  87.  
  88.    CopyFiles = True
  89.  
  90. ExitFunc:
  91.    ChDir CurrDir$
  92.    Exit Function
  93. DirErr:
  94.    frmMain!txtInfo = "Error: " & Error$(Err)
  95.    CopyFiles = False
  96.    Resume ExitFunc
  97. PathErr:
  98.    If Err = 75 Or Err = 76 Then ' si no encontramos el path
  99.       frmMain!txtInfo.Text = txtInfo.Text & vbCrLf & "Making directory " & dstPath
  100.       frmMain!txtInfo.Refresh
  101.       MkDir dstPath
  102.       Resume Next
  103.    End If
  104.    GoTo DirErr
  105. End Function

La función para seleccionar los folders origen y destino.

Texto Plano
Visual Basic:
  1. Function seleccionaFolder()
  2.     Dim bi As BROWSEINFO 'declaramos algunas variables que necesitamos
  3.     Dim rtn&, pidl& 'es lo mismo si se declara Dim rtn As Long
  4.     Dim path$, path1$ ' es lo mismo si se declara Dim path As String
  5.     Dim pos% ' es lo mismo si se declara Dim  pos As Integer
  6.    
  7.     Dim var1%, SpecIn$
  8.    
  9.     bi.hOwner = Me.hWnd 'Centramos la caja de dialogo en la pantalla
  10.     bi.lpszTitle = "Seleccione Una Carpeta..." 'Colocamos el Titulo
  11.     bi.ulFlags = BIF_RETURNONLYFSDIRS 'El tipo de folder(s) a regresar
  12.     pidl& = SHBrowseForFolder(bi) 'mostramos la caja de dialogo
  13.      
  14.     path = Space(512) 'colocamos el maximo de characters
  15.     var1 = SHGetPathFromIDList(ByVal pidl&, ByVal path) 'Obtenemos el path seleccionado
  16.    
  17.     If var1> 0 Then
  18.         pos% = InStr(path$, Chr$(0)) 'extraemos el path de la cadena
  19.         path$ = Left(path$, pos - 1) 'guardamos el path extraido
  20.         'aseguramos que el path termine con "\"
  21.         If Right$(path$, 1) <> "\" Then path$ = path$ & "\"
  22.         seleccionaFolder = path$        ' colocamos el resultado
  23.     End If
  24. End Function

Ahora los eventos.

Primero el botón de comando Destino.

Texto Plano
Visual Basic:
  1. Private Sub cmdDestino_Click()
  2.     Me.txtDestino.Text = seleccionaFolder
  3. End Sub

Ahora el botón de comando Origen.

Texto Plano
Visual Basic:
  1. Private Sub cmdOrigen_Click()
  2.     Me.txtOrigen.Text = seleccionaFolder
  3. End Sub

El botón de comando Copiar.

Texto Plano
Visual Basic:
  1. Private Sub cmdCopiar_Click()
  2.     If Me.txtDestino.Text <> "" And Me.txtOrigen <> "" Then
  3.         Call CopyFiles(Me.txtOrigen.Text, Me.txtDestino.Text, chkIncuirSubFolders.Value, "*.*") ' puedes especificar un tipo de archivo
  4.     Else
  5.         MsgBox "Datos Incompletos"
  6.     End If
  7. End Sub

Y finalmente creamos un modulo, dando un clic en el menú Project y clic en el item agregar modulo (add module), clic en abrir (open).
Y pegamos el siguiente código:

Texto Plano
Visual Basic:
  1. ' modulo para mostrar caja de dialogo y seleccionar un folder
  2. Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  3. Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
  4. Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
  5.  
  6. Type SHITEMID
  7.      cb As Long
  8.      abID As Byte
  9. End Type
  10.  
  11. Type ITEMIDLIST
  12.      mkid As SHITEMID
  13. End Type
  14.  
  15. Type BROWSEINFO
  16.      hOwner As Long
  17.      pidlRoot As Long
  18.      pszDisplayName As String
  19.      lpszTitle As String
  20.      ulFlags As Long
  21.      lpfn As Long
  22.      lParam As Long
  23.      iImage As Long
  24. End Type
  25.  
  26. Public Const NOERROR = 0
  27.  
  28. Public Const BIF_RETURNONLYFSDIRS = &H1
  29. Public Const BIF_DONTGOBELOWDOMAIN = &H2
  30. Public Const BIF_STATUSTEXT = &H4
  31. Public Const BIF_RETURNFSANCESTORS = &H8
  32. Public Const BIF_BROWSEFORCOMPUTER = &H1000
  33. Public Const BIF_BROWSEFORPRINTER = &H2000

 

floppy.jpg
Clic para descargar el archivo
]]> http://ayuda.fotopex.com/programacion/vb/copiar-archivos-incluyendo-subdirectorios-como-xcopy-s/feed/ 0 Exportar Recordset MS Access a MS Excel http://ayuda.fotopex.com/programacion/vb/exportar-recordset-ms-access-a-ms-excel/ http://ayuda.fotopex.com/programacion/vb/exportar-recordset-ms-access-a-ms-excel/#comments Wed, 23 Jan 2008 22:08:05 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/exportar-recordset-ms-access-a-ms-excel/

Para hacer la exportación de los datos de una tabla por medio de un Recordset primero abrimos visual basic y creamos un nuevo proyecto, necesitamos agregar las referencias Microsoft Excel 9.0 Object Library y Microsoft Activex Data objects 2.0 Library.

Ahora agregamos un boton de comando y declaramos las variables que utilizaremos.

Texto Plano
Visual Basic:
  1. 'Recuerda que debes a&ntilde;adir las referencias
  2. 'Microsoft Excel 9.0 Object Library
  3. 'Microsoft Activez Data objects 2.0 Library
  4.  
  5. Option Explicit
  6.  
  7. Dim H As Integer
  8. Dim V As Integer
  9.  
  10. Public objExcel As Excel.Application
  11. Dim Rs As Recordset
  12. Dim db As Connection

La función para conectar a la base de datos.

Texto Plano
Visual Basic:
  1. Sub conectaDB()
  2.   Set db = New Connection
  3.   db.CursorLocation = adUseClient
  4.   db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=db1.mdb;"
  5.  
  6.   Set Rs = New Recordset
  7.   Rs.Open "select apellidos,direccion,dni,nombre,pais,poblacion,provincia,telefono from clientes", db, adOpenStatic, adLockOptimistic
  8. End Sub

El evento al botón.

Texto Plano
Visual Basic:
  1. Private Sub Command1_Click()
  2.      
  3.      Call conectaDB
  4.    
  5.     'guardamos en un array los nombres del encabezado de cada columna
  6.     Dim Heading(8) As String
  7.     Heading(0) = "Nombre"
  8.     Heading(1) = "Apellidos"
  9.     Heading(2) = "Direccion"
  10.     Heading(3) = "Poblacion"
  11.     Heading(4) = "Provincia"
  12.     Heading(5) = "Pais"
  13.     Heading(6) = "Telefono"
  14.     Heading(7) = "DNI"
  15.            
  16.    
  17.     Call Inicio_Excel 'Llamamos a la funcion que abre el workbook en excel
  18.     Call Formato_Excel(8, Heading()) 'llamamos a la funcion que da el formato al encabezado
  19.    
  20. V = 5 ' fila donde comenzara a insertar los datos
  21. H = 1 ' columna donde comenzara a insertar los datos
  22.  
  23.      Do While Not Rs.EOF 'esto nos sirve pa leer los datos desde
  24.         'la tabla de access para despues colocarlos en las celdas correspondientes
  25.        With Rs
  26.             objExcel.ActiveSheet.Cells(V, H) = .Fields!nombre
  27.             objExcel.ActiveSheet.Cells(V, H + 1) = .Fields!apellidos
  28.             objExcel.ActiveSheet.Cells(V, H + 2) = .Fields!direccion
  29.             objExcel.ActiveSheet.Cells(V, H + 3) = .Fields!poblacion
  30.             objExcel.ActiveSheet.Cells(V, H + 4) = .Fields!provincia
  31.             objExcel.ActiveSheet.Cells(V, H + 5) = .Fields!pais
  32.             objExcel.ActiveSheet.Cells(V, H + 6) = .Fields!telefono
  33.             objExcel.ActiveSheet.Cells(V, H + 7) = .Fields!dni
  34.             V = V + 1
  35.             .MoveNext
  36.         End With
  37.     Loop
  38.  Set objExcel = Nothing 'una vez hemos terminado descargamos el objeto
  39.  
  40. End Sub

La función para iniciar MS Excel.

Texto Plano
Visual Basic:
  1. Public Function Inicio_Excel() As Boolean
  2.  
  3. Set objExcel = New Excel.Application
  4. objExcel.Visible = True 'lo hacemos visible
  5. objExcel.SheetsInNewWorkbook = 1 'decimos cuantas hojas queremos en el nuevo documento
  6. objExcel.Workbooks.Add ' a&ntilde;adimos el objeto al workbook
  7.  
  8. End Function

La función para los encabezados en MS Excel.

Texto Plano
Visual Basic:
  1. Public Function Formato_Excel(Num_Campos As Integer, Nombre_Campos() As String) As Boolean
  2.  
  3. Dim I As Integer
  4.  
  5. With objExcel.ActiveSheet
  6.        
  7.     'Formato de las celdas de los encabezados
  8.     .Range(.Cells(3, 1), .Cells(3, Num_Campos)).Borders.LineStyle = xlContinuous
  9.     .Range(.Cells(3, 1), .Cells(3, 8)).Font.Bold = True
  10.    
  11.     'Ingresamos el texto a las celdas
  12.     For I = 1 To Num_Campos - 1 Step 1
  13.         .Cells(3, I) = Nombre_Campos(I)
  14.     Next I
  15.     ' asignamos el ancho de las celdas
  16.     .Columns("A").ColumnWidth = 25
  17.     .Columns("B").ColumnWidth = 35
  18.     .Columns("C").ColumnWidth = 30
  19.     .Columns("D").ColumnWidth = 20
  20.     .Columns("E").ColumnWidth = 15
  21.     .Columns("F").ColumnWidth = 15
  22.     .Columns("G").ColumnWidth = 10
  23.     .Columns("H").ColumnWidth = 10
  24. End With
  25. End Function

Espero que te sirva este ejemplo y aqui puedes descargarte los archivos del código.

floppy.jpg
Clic para descargar el archivo
]]> http://ayuda.fotopex.com/programacion/vb/exportar-recordset-ms-access-a-ms-excel/feed/ 2 Como Registrar Componentes via API Windows http://ayuda.fotopex.com/programacion/vb/como-registrar-componentes-via-api-windows/ http://ayuda.fotopex.com/programacion/vb/como-registrar-componentes-via-api-windows/#comments Mon, 21 Jan 2008 22:31:47 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/como-registrar-componentes-via-api-windows/ Un recurso que encontré en la red hace mucho tiempo de como se pueden registrar componentes ActiveX, ya sean OCX o DLL (no DLL Win32).

El método en cuestión muestra el uso de las funciones DllRegisterServer() y DllUnregisterServer(). Estas funciones tienen la peculiaridad a la hora de ser declaradas de que no apuntan a una librería concreta como origen de la función si no hacia el componente que queremos registrar.

Este ejemplo muestra como registrar o eliminar del registro el componente "ComCtl32.OCX":

Texto Plano
Visual Basic:
  1. 'KPD-Team 1999
  2. 'URL: http://www.allapi.net/
  3. 'E-Mail: KPDTeam@Allapi.net
  4.  
  5. Declare Function DllRegisterServer Lib "ComCtl32.OCX" () As Long
  6. Declare Function DllUnregisterServer Lib "ComCtl32.OCX" () As Long
  7.  
  8. Const ERROR_SUCCESS = &H0
  9.  
  10. ' Para instalar el componente del sistema utilizar esta función:
  11. If DllRegisterServer = ERROR_SUCCESS Then
  12.     MsgBox "El componente ha sido instalado satisfactoriamente."
  13.  
  14. Else
  15.     MsgBox "Error al registrar el componente."
  16.  
  17. End If
  18.  
  19. ' Para desinstalar el componente del sistema utilizar esta función:
  20. If DllUnregisterServer = ERROR_SUCCESS Then
  21.     MsgBox "El componente ha sido desinstalado satisfactoriamente."
  22.  
  23. Else
  24.     MsgBox "El componente no ha podido ser eliminado del registro."
  25.  
  26. End If

]]> http://ayuda.fotopex.com/programacion/vb/como-registrar-componentes-via-api-windows/feed/ 0 ¿Cómo crear una Funcion en VB? http://ayuda.fotopex.com/programacion/vb/%c2%bfcomo-crear-una-funcion-en-vb/ http://ayuda.fotopex.com/programacion/vb/%c2%bfcomo-crear-una-funcion-en-vb/#comments Sat, 19 Jan 2008 16:56:38 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/%c2%bfcomo-crear-una-funcion-en-vb/ Cómo crear una Funcion en VB - How to Create a Function in VBHow to Create a Function in VB?
Una Función es más o menos lo mismo que un Sub (un segmento de código que usted crea), y que puede ser usado siempre que lo desee. La diferencia es que una función devuelve un valor, mientras que un Sub no. Cuan necesitas llamar a la funcion lo haces de la siguiente forma:

Call Funcion(variable1, variable2)

Ó también puede hacerlo como en el siguiente ejemplo:

Texto Plano
Visual Basic:
  1. Private Sub Command1_Click()
  2.     Me.Text3.Text = suma(Me.Text1.Text, Me.Text2.Text)
  3.    
  4. End Sub
  5.  
  6. Private Function suma(val1, val2)
  7.     If IsNull(val1) Or IsNull(val2) Then
  8.         MsgBox "Datos incompletos"
  9.         Exit Function
  10.     End If
  11.     suma = Val(val1) + Val(val2)
  12. End Function

]]> http://ayuda.fotopex.com/programacion/vb/%c2%bfcomo-crear-una-funcion-en-vb/feed/ 0 Gráfica 3d pie sin OCX en vb http://ayuda.fotopex.com/programacion/vb/grafica-3d-pie-sin-ocx-en-vb/ http://ayuda.fotopex.com/programacion/vb/grafica-3d-pie-sin-ocx-en-vb/#comments Fri, 04 Jan 2008 17:31:30 +0000 Mr. FotoPex http://ayuda.fotopex.com/programacion/vb/grafica-3d-pie-sin-ocx-en-vb/

3d-pie.JPG

Bastante austero pero es un buen comienzo.

Solo necesitamos un commandButton y un PictureBox.

Texto Plano
Visual Basic:
  1. Private Sub Command1_Click()
  2. Dim PI, circStart, circEnd, gPercent, jPercent, nX, nY, rad
  3. nX = Picture1.ScaleWidth \ 2
  4. nY = Picture1.ScaleHeight \ 2
  5.  
  6. rad = 1000
  7. gPercent = 75
  8. jPercent = 25
  9.  
  10. PI = 22 / 7
  11. circStart = (gPercent * PI) / 180
  12. circEnd = (jPercent * PI) / 180
  13.  
  14. Picture1.DrawWidth = 1
  15. Picture1.FillStyle = 0
  16. Picture1.FillColor = vbBlue
  17. 'The For - Next is not nested for clarity
  18.     For i = 1 To 200
  19.     Picture1.Circle (nX, nY), rad, vbRed, -circStart, -circEnd, -1
  20.     nX = nX + 1
  21.     nY = nY + 1
  22. Next i
  23.  
  24. Picture1.FillColor = vbRed
  25. For j = 1 To 200
  26.     'Adjusting the nX and nY moves the wedge
  27.     Picture1.Circle (nX + 200, nY - 500), rad, vbBlue, -circEnd, -circStart, -1
  28.     nX = nX + 1
  29.     nY = nY + 1
  30. Next j
  31.  
  32. End Sub

]]> http://ayuda.fotopex.com/programacion/vb/grafica-3d-pie-sin-ocx-en-vb/feed/ 0