Biblioteca de código

[ranefi]

Abrir, Guardar y Cerrar una hoja de calculo de Microsoft Excel

Agregar un CommandButton

Código:

Private Sub Command1_Click()
            Dim appExcel As Object
            Dim ArchivoApestoso As String
           
            ArchivoApestoso = App.Path & "\Apestoso.xls"
            Set appExcel = CreateObject("Excel.Application")
           
            appExcel.Visible = True
            appExcel.WorkBooks.Open FileName:=ArchivoApestoso
           
            With appExcel.ActiveSheet
                        .Range("A1").Formula = "Hola mundo"
                        .Range("B2").Formula = "Te saluda"
                        .Range("C3").Formula = "ranefi"
                        .Range("D4").Formula = "Muerete de miedo, que voy por ti"
            End With
           
            appExcel.ActiveWorkBook.Save
            appExcel.ActiveWindow.Close
End Sub

Bueno, ya se saben la historia, tener una hoja de calculo llamada Apestoso.xls en la misma ruta de la aplicación. Nos vemos cochinones.

[ranefi]

Crear hoja de calculo de Microsoft Excel, Introducir datos, Guardar Como y Cerrar

Agregar un CommandButton

Código:

Private Sub Command1_Click()
            Dim CochinoExcel As Object
           
            Set CochinoExcel = CreateObject("Excel.Application")
           
            CochinoExcel.Visible = True
            CochinoExcel.Workbooks.Add
           
            With CochinoExcel.ActiveSheet
                        .Range("A1").Formula = "Hola mundo"
                        .Range("B2").Formula = "Te saluda"
                        .Range("C3").Formula = "ranefi"
                        .Range("D4").Formula = "Muerete de miedo, que voy por ti"
            End With
           
            CochinoExcel.ActiveWorkBook.SaveAs FileName:=App.Path & "\Apestoso2.xls"
            CochinoExcel.ActiveWindow.Close
End Sub

Esto también es muy útil.     ¡Hey peladetes!,     ¿Sabían que si llegan a tener una duda sobre qué tipo de código usar para alguna otra función de Excel, basta con que entren a Excel y seleccionen la opción "Grabar Macros", realicen la función que desean y que después revisen el código en el Editor de Visual Basic? En pocas palabras, las Macros en Excel les dan la solución. Nos vemos pelaos.

[ranefi]

Sonidos estilo QBasic

Introducir el siguiente código en la ventana de código de Visual Basic:

Código:

Private Declare Function Beep Lib "kernel32" _
            (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub Form_Activate()
            Dim CuentaCochina As Long
           
            For CuentaCochina = 0 To 500 Step 10
                        Beep CuentaCochina, 50
                        Me.Caption = CuentaCochina
                        DoEvents
            Next CuentaCochina
End Sub

Nos vemos.

[ranefi]

Crear un archivo aleatorio (texto) e introducir el contenido de un TextBox dentro de dicho archivo

Agregar un CommandButton y un TextBox

Código:

Private Sub Command1_Click()
            Dim Archivo As String
            Dim NumArchivo As Long
           
            Archivo = App.Path & "\ranefi.txt"
            NumArchivo = FreeFile()
           
            Open Archivo For Output As #NumArchivo
                        Print #NumArchivo, Text1.Text
            Close #NumArchivo
End Sub

[ranefi]

Modificar el formato de Time y Date

Agregar 4 controles Label (Etiquetas) y un CommandButton (botón)

Código:

Private Sub Command1_Click()
            Label2.Caption = Format(Label1.Caption, "hh:mm:ss AMPM")
            Label4.Caption = Format(Label3.Caption, "dddd mmmm d yyyy")
End Sub

Private Sub Form_Load()
            Label1.Caption = Time
            Label3.Caption = Date
End Sub

See ya.

[ranefi]

Agregar sonido Wav a un evento

Agregar un CommandButton e introducir el siguiente código:

Esto va en un módulo:

Código:

Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
            (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Public Const SND_SYNC = &H0
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_LOOP = &H8
Public Const SND_NOSTOP = &H10

Public Sub SonidoSucio(strSound As String)
            Dim wFlags%
           
            wFlags% = SND_ASYNC Or SND_NODEFAULT
            sndPlaySound strSound, wFlags%
End Sub

Esto va en el formulario:

Código:

Private Sub Command1_Click()
            SonidoSucio App.Path & "\caca.wav"
End Sub

Es menester aclarar que debemos tener un archivo de sonido llamado caca.wav en la misma ruta de nuestra aplicación. Nos vemos.

[ranefi]

Verificar la existencia de un archivo

Agregar un CommandButton e introducir lo siguiente:

Código:

Public Function FileExists%(fname$)
On Local Error Resume Next
            Dim ff%
           
            ff% = FreeFile
           
            Open fname$ For Input As ff%
                        If Err Then
                                    FileExists% = False
                        Else
                                    FileExists% = True
                        End If
            Close ff%
End Function


Private Sub Command1_Click()
            Dim MugrosoArchivo As String
           
            MugrosoArchivo = "C:\ranefisayshello.txt"
           
            Success% = FileExists%(MugrosoArchivo)
           
            If Success% = True Then
                        FileCopy MugrosoArchivo, "C:\ranefisaysbye.txt"
            Else
                        MsgBox "No lo puedo creer, no tienes a ranefi en tu PC", _
                                    vbCritical, "Hola mundo"
            End If
End Sub

Nota: Debes crear un archivo de texto en la unidad C llamado ranefisayshell o.txt


Esto es muy útil si deseas crear condiciones anidadas que comprueben la existencia de un archivo. Nos vemos.

[ranefi]

Abrir y Cerrar unidad de CD

Agregar 2 CommandButton e introducir lo siguiente:

En un módulo:

Código:

Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
            (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
            ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

En el formulario:

Código:

Private Sub Command1_Click()
            mciSendString "set CDAudio door open", "", 127, 0
End Sub

Private Sub Command2_Click()
            mciSendString "set CDAudio door closed", "", 127, 0
End Sub

Esto abrirá la unidad predeterminada de CD. Nos vemos.

[ranefi]

Obtener la ruta de la carpeta de Windows

Agregar un CommandButton e introducir lo siguiente:

Código:

Private Declare Function GetWindowsDirectory Lib "kernel32" _
            Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
            ByVal nSize As Long) As Long


Private Sub Command1_Click()
            Dim Bufer As String
            Dim RutaWindows As String
           
            Bufer = String(200, Chr$(0))

            RutaWindows = Left$(Bufer, GetWindowsDirectory(Bufer, Len(Bufer)))
           
            Me.Caption = RutaWindows
End Sub

Les mostrará la ruta de la carpeta de Windows en el título (caption) del formulario. Nos vemos.

[ranefi]

Obtener la ruta de la carpeta System32

Agregar un CommandButton e introducir lo siguiente:

Código:

Private Declare Function GetSystemDirectory Lib "kernel32" _
            Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
            ByVal nSize As Long) As Long


Private Sub Command1_Click()
            Dim Bufer As String
            Dim RutaWindows As String
           
            Bufer = String(200, Chr$(0))

            RutaWindows = Left$(Bufer, GetSystemDirectory(Bufer, Len(Bufer)))
           
            Me.Caption = RutaWindows
End Sub

Esto mostrará la ruta de la carpeta System32 en el título (caption) del formulario. Nos vemos cochinones.

[ranefi]

Obtener el nombre de la computadora

Introducir lo siguiente:

Código:

Private Const MAX_COMPUTERNAME_LENGTH As Long = 31

Private Declare Function GetComputerName Lib "kernel32" _
            Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Private Sub Form_Load()
            Dim dwLen As Long
            Dim strString As String

            dwLen = MAX_COMPUTERNAME_LENGTH + 1
            strString = String(dwLen, "X")

            GetComputerName strString, dwLen

            strString = Left(strString, dwLen)

            Me.Caption = strString
End Sub

Esto mostrará el nombre de la PC en el título (caption) del formulario. Nos vemos.

[ranefi]

Destruir ventana

Agregar un CommandButton e introducir lo siguiente:

Código:

Private Declare Function DestroyWindow Lib "user32" _
            (ByVal hwnd As Long) As Long


Private Sub Command1_Click()
            DestroyWindow Me.hwnd
End Sub

Es fácil,     ¿no creen?

[ranefi]

Hacer que parpadee una ventana

Agregar un Timer e introducir lo siguiente:

Código:

Private Declare Function FlashWindow Lib "user32" _
            (ByVal hwnd As Long, ByVal bInvert As Long) As Long

Const Invert = 1

Private Sub Form_Load()
            Timer1.Interval = 50
End Sub

Private Sub Timer1_Timer()
            FlashWindow Me.hwnd, Invert
End Sub

Esto es algo parecido al anuncio que hace el Messenger cuando nos están hablando. Nos vemos.

[ranefi]

Bloquear Ratón y Teclado durante 10 segundos

Agregar un Timer y un CommandButton e introducir lo siguiente:

En un módulo

Código:

Public Declare Function BlockInput Lib "user32" _
            (ByVal fBlock As Long) As Long

Declare Function ShowCursor Lib "user32" _
            (ByVal bShow As Long) As Long

En el formulario

Código:

Private Sub Command1_Click()
            BlockInput True
            ShowCursor False
End Sub

Private Sub Form_Load()
            Timer1.Interval = 10000
End Sub

Private Sub Timer1_Timer()
            BlockInput False
            ShowCursor True
End Sub

    ¿Qué se podrá hacer con esto? Jejejejeje, cochinones.

[ranefi]

Ventana siempre visible

REPLACEar lo siguiente:

Código:

Private Declare Function SetWindowPos Lib "user32" _
            (ByVal hWnd As Long, ByVal hWndREPLACEAfter As Long, _
            ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
            ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

Public Sub VentanaSiempreFregando(hWnd As Long)
            SetWindowPos hWnd, HWND_TOPMOST, _
                        0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

Public Sub VentanaNormal(hWnd As Long)
            SetWindowPos hWnd, HWND_NOTOPMOST, _
                        0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

Private Sub Form_Load()
            VentanaSiempreFregando Me.hWnd
End Sub

VentanaSiempre Fregando servirá para mantener a la ventana siempre visible y VentanaNormal servirá para que sea normal. Nos vemos.