Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Sub Ejecutar()
Dim Valor As String
For Each C In Range("A5:B7")
Valor = C.Value
MsgBox Valor
Next
End Sub
negro, despierta siempre el mismo dia junto a su esposa y es acusado de asesinato. El caso es que el hace hasta lo imposible para salir ileso, pero se vuelve una rutina, cuando el dia acaba, luego de descansar y al despertar se da cuenta que es el mismo dia que vivio ayer. Luego comienza a jugar con el tiempo, sabiendo que sucede busca nuevas estrategias para lograr safarce del problema.
UPDATE tbl_reporte_temporal
SET (existencia_inicial) =
(SELECT SUM(tbl_DcierreInventario.Existencia_I) AS Existencia
FROM tbl_reporte_temporal
WHERE (tbl_DcierreInventario.CodAlmacen = '1') AND (tbl_DcierreInventario.fechacierre = '17/05/2010')
GROUP BY tbl_DcierreInventario.coditems)
WHERE tbl_DcierreInventario.coditems = tbl_reporte_temporal.coditems
'Funciones Api
''''''''''''''''''''''''''''''
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SetMenuInfo Lib "user32" ( _
ByVal hMenu As Long, _
Mi As MENUINFO) As Long
'Constantes
''''''''''''''''''''''''''''''
Private Const MIM_BACKGROUND As Long = &H2
Private Const MIM_APPLYTOSUBMENUS As Long = &H80000000
'Estructura MENUINFO
Private Type MENUINFO
cbSize As Long
fMask As Long
dwStyle As Long
cyMax As Long
RhbrBack As Long
dwContextHelpID As Long
dwMenuData As Long
End Type
Public Function Establecer_Color_Menu( _
ByVal hwndfrm As Long, _
ByVal Color As Long, _
ByVal SubMenu As Boolean) As Boolean
Dim Mi As MENUINFO
Dim flags As Long
flags = MIM_BACKGROUND
If SubMenu Then
'si queremos establecer el color al submenú
'debemos asignarle esta constante al Flag
flags = flags Or MIM_APPLYTOSUBMENUS
End If
'Llenamos la estructura MENUINFO
With Mi
'Tamaño de la estructura
.cbSize = Len(Mi)
'Flag para determinar el submenu
.fMask = flags
'Le enviamos este color a esta variable
.RhbrBack = CreateSolidBrush(Color)
End With
'Establecemos la informacion del menu
'pasandole el hwnd del menu que lo recupeamos
'con getMenu y en el otro parametro la estructura MENUINFO
Call SetMenuInfo(GetMenu(hwndfrm), Mi)
'Dibujamos el color pasandole el hwnd del
'Form que contiene el menu
Call DrawMenuBar(hwndfrm)
End Function
'vbBlue es el color que asigne, pueden colocar otro... Saludos
Private Sub Form_Initialize()
Call Establecer_Color_Menu(Me.hwnd, vbBlue, True)
End Sub
Option Explicit
Private Declare Function GetDC Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private lngDC As Long
Private blnLoop As Boolean
Dim m1 As Integer, m2 As Integer
Private Sub Form_Click()
blnLoop = vbFalse
Unload Me
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
blnLoop = vbFalse
End Sub
Sub ElEfecto()
Dim intX As Integer, intY As Integer
Dim intI As Integer, intJ As Integer
Dim intWidth As Integer, intHeight As Integer
intWidth = Screen.Width / Screen.TwipsPerPixelX
intHeight = Screen.Height / Screen.TwipsPerPixelY
frmMain.Width = Screen.Width
frmMain.Height = Screen.Height
lngDC = GetDC(0)
Call BitBlt(hDC, 0, 0, intWidth, intHeight, lngDC, 0, 0, vbSrcCopy)
frmMain.Visible = vbTrue
frmMain.AutoRedraw = vbFalse
Randomize
blnLoop = vbTrue
Do While blnLoop = vbTrue
intX = (intWidth - 128) * Rnd
intY = (intHeight - 128) * Rnd
intI = m1 * Rnd - 1
intJ = m2 * Rnd - 1
Call BitBlt(frmMain.hDC, intX + intI, intY + intJ, 128, 128, frmMain.hDC, intX, intY, vbSrcCopy)
DoEvents
Loop
Set frmMain = Nothing
Call ReleaseDC(0, lngDC)
End
End Sub
Private Sub Form_Load()
On Error GoTo er1
frmMain.AutoRedraw = True
Dim ef As Integer
ef = GetSetting("MeltSCR", "Effect", "Effect")
Select Case ef
Case 0
m1 = 2: m2 = 2
Case 1
m1 = 20: m2 = 20
Case 2
m1 = 9: m2 = 9
Case 3
m1 = 0: m2 = 0
Case 4
m1 = 3: m2 = 3
Case 5
m1 = 5: m2 = 5
Case 6
m1 = 10000: m2 = 10000
Case 7
m1 = 1000: m2 = 1000
Case 8
m1 = 10: m2 = 2
Case 9
m1 = 2: m2 = 10
End Select
ElEfecto
Exit Sub
er1:
m1 = 2: m2 = 2
ElEfecto
End Sub
ListView1.SelectedItem.Index = ListView1.SelectedItem.Index + 1
Private Sub ListView1_ColumnClick( _
ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'lvwAscending ' orden ascendente
'lvwDescending ' orden descendente
With ListView1
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If
.Sorted = True
' columna por la cual se ordena
'( en este caso hay una sola )
.SortKey = 0
End With
End Sub