Jump to content

rolano

Members
  • Content Count

    1,200
  • Joined

  • Last visited

  • Days Won

    10
  • Country

    Peru

Reputation Activity

  1. ¡Excelente!
    rolano reacted to Antoni in Esto si es un ME GUSTA y lo demás son tonterías   
    Cálculo de rutas de montaña
  2. Like
    rolano got a reaction from marcosab in Ayuda con conexion de Excel a ACCESS   
    Hola Marcosab, revisa el adjunto.
     
    Puedes explicar un poco mas con ejemplo.
    Datos.ro.rar
  3. Like
    rolano got a reaction from temp01 in ERROR DE MACRO EN WINDOWS 10   
    Public Declare PtrSafe Function SetTimer Lib "user32" ( _ ByVal hWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As LongPtr) As Long 'LongPtr cambialo por Long Hola a todos, es esta parte cambia LongPtr por Long, a mi me funciona as´s.
  4. Like
    rolano got a reaction from temp01 in ERROR DE MACRO EN WINDOWS 10   
    Public Declare PtrSafe Function SetTimer Lib "user32" ( _ ByVal hWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As LongPtr) As Long 'LongPtr cambialo por Long Hola a todos, es esta parte cambia LongPtr por Long, a mi me funciona as´s.
  5. Like
    rolano got a reaction from Jose BN in Finding All Reports In A Database When I Search With Access Using vba   
    Sub Apri_Tabella() On Error Resume Next DoCmd.Close DoCmd.OpenTable "Tabella_Database", acViewNormal End Sub Hola, revisa este código.
  6. Like
    rolano got a reaction from temp01 in ERROR DE MACRO EN WINDOWS 10   
    Public Declare PtrSafe Function SetTimer Lib "user32" ( _ ByVal hWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As LongPtr) As Long 'LongPtr cambialo por Long Hola a todos, es esta parte cambia LongPtr por Long, a mi me funciona as´s.
  7. ¡Excelente!
    rolano got a reaction from Visor in Si abres este archivo, entonces puede ser que la macro no funciona   
    Hola a todos, tu archivo no abre porque tienes que tienes que colocar el numero de serie de tu disco C en la hojas.


    CONTROL RECONOCIMIENTO DE COMPUTADOR.xlsm
  8. ¡Excelente!
    rolano got a reaction from Visor in Si abres este archivo, entonces puede ser que la macro no funciona   
    Hola Antoni un gusto saludarte, allí debería ser hoja3 y no hoja1, ahora lo que hice es poner manualmente el numero de serie disco C en la hoja3 celda Range("B100000").
  9. Thanks
    rolano got a reaction from Enid86 in Ingresar datos en Matriz de dos dimensiones   
    Option Explicit Option Base 1 'EXPORTAR DATOS Sub Botón3_Haga_clic_en_R() 'On Error GoTo etiqueta Application.ScreenUpdating = False Dim vehiculo As String, fila As Long, colum As Long Dim NCarga As String, FechaSalida As String, FechaLlegada As String, PoblaciónOrigen As String, PoblaciónDestino As String Dim KmsNac As Integer, KmsInt As Integer, Precioventa As Double, PrecioKmsNac As Double, PrecioKmsInt As Double Dim filadest As Integer, columdest As Integer Dim pasardatos As Long, ultimafila As Long Dim Hoja As String Dim listacamioneskm() As String, i As Integer, matriz As Range Dim CantFila As Long Dim HojaEstado As Object 'funciona Worksheets("listacamioneskm").Select CantFila = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Range("A1:A" & CantFila).Select 'funciona i = 1 For Each matriz In Selection ReDim Preserve listacamioneskm(CantFila) listacamioneskm(i) = matriz.Value i = i + 1 Next matriz fila = 2 colum = 0 'filadest = 2 columdest = 1 Do Worksheets("GS").Select 'hoja = Cells(fila, colum + 1).Value 'fila 2, columna 1 vehiculo = Cells(fila, 1).Value If vehiculo = "" Then Exit Sub If UBound(Filter(listacamioneskm, vehiculo)) >= 0 Then vehiculo = Cells(fila, 1).Value NCarga = Cells(fila, 2).Value FechaSalida = Cells(fila, 3).Value FechaLlegada = Cells(fila, 4).Value PoblaciónOrigen = Cells(fila, 5).Value PoblaciónDestino = Cells(fila, 6).Value KmsNac = Cells(fila, 7).Value KmsInt = Cells(fila, 8).Value Precioventa = Cells(fila, 9).Value PrecioKmsNac = Cells(fila, 10).Value PrecioKmsInt = Cells(fila, 11).Value 'enviamos datos 'hay que enviar antes de que salte de fila Worksheets(vehiculo).Select filadest = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Sheets(vehiculo).Cells(filadest + 1, columdest).Value = vehiculo Sheets(vehiculo).Cells(filadest + 1, columdest + 1).Value = NCarga Sheets(vehiculo).Cells(filadest + 1, columdest + 2).Value = FechaSalida Sheets(vehiculo).Cells(filadest + 1, columdest + 3).Value = FechaLlegada Sheets(vehiculo).Cells(filadest + 1, columdest + 4).Value = PoblaciónOrigen Sheets(vehiculo).Cells(filadest + 1, columdest + 5).Value = PoblaciónDestino Sheets(vehiculo).Cells(filadest + 1, columdest + 6).Value = KmsNac Sheets(vehiculo).Cells(filadest + 1, columdest + 7).Value = KmsInt Sheets(vehiculo).Cells(filadest + 1, columdest + 8).Value = PrecioKmsNac Sheets(vehiculo).Cells(filadest + 1, columdest + 9).Value = PrecioKmsInt Sheets(vehiculo).Cells(filadest + 1, columdest + 10).Value = Precioventa End If fila = fila + 1 Loop While vehiculo <> "" Application.ScreenUpdating = True End Sub Hola a todos, es tu misma rutina (Módulo3), con algunas modificaciones,. revisalo. Si tienes otra pregunta abre un nuevo tema para que tengas mas oportunidad de ayuda.
    MACROMod.xlsm
  10. Thanks
    rolano got a reaction from Enid86 in Ingresar datos en Matriz de dos dimensiones   
    Hola, como relacionas tu tabla Hoja(GS") y Hoja("listacamioneskm") o  Hoja("listacamioneskms").
    En tu Hoja("GS") deberías insertar en la columna "A"  Vehículo y sus respectivos números. Porque para extraer la informacion de la Hoja(GS") a las Hoja("1111") y sucesivo, se necesita que en la Hoja(GS") tenga una relación con las otras hojas.
    Después Option Explicit coloca
    Option Base 1
     
  11. Like
    rolano reacted to JSDJSD in Cómo utilizar celda activa de hoja no activa?   
    Esta es la aplicación muy fácil de utilizar.
  12. Like
    rolano reacted to Antoni in Como asignar formatos a columnas en un listbox   
    Así también valdría:
    ... ListBox1.List(a, 6) = Sheets("bd").Cells(fila, 10).Text ListBox1.List(a, 7) = Sheets("bd").Cells(fila, 13).Text ListBox1.List(a, 8) = Sheets("bd").Cells(fila, 14).Text ListBox1.List(a, 9) = Sheets("bd").Cells(fila, 15).Text ...  
  13. Like
    rolano got a reaction from Antoni in Como asignar formatos a columnas en un listbox   
    'Copia los datos de la celda list box a = ListBox1.ListCount ListBox1.AddItem ListBox1.List(a, 0) = Sheets("bd").Cells(fila, 2) ListBox1.List(a, 1) = Sheets("bd").Cells(fila, 3) ListBox1.List(a, 2) = Sheets("bd").Cells(fila, 4) ListBox1.List(a, 3) = Sheets("bd").Cells(fila, 7) ListBox1.List(a, 4) = Sheets("bd").Cells(fila, 8) ListBox1.List(a, 5) = Sheets("bd").Cells(fila, 9) ListBox1.List(a, 6) = Format(Sheets("bd").Cells(fila, 10), "$###,##0") 'Cambiar ListBox1.List(a, 7) = Format(Sheets("bd").Cells(fila, 13), "$###,##0") 'Cambiar ListBox1.List(a, 8) = Format(Sheets("bd").Cells(fila, 14), "$###,##0") 'Cambiar ListBox1.List(a, 9) = Format(Sheets("bd").Cells(fila, 15), "$###,##0") 'Cambiar Hola, cambia en el fila  10, 13, 14 y 15 (Format(Sheets("bd").Cells(fila, 10), "$###,##0") 'Cambiar)
  14. Thanks
    rolano got a reaction from Enid86 in Acceder a todos los valores de una matriz para compararlos con variable   
    option base 1 for x = 1 to 23 If vehiculo = listacalidad(x) then 'codigo end if Hola, prueba con este código.
  15. Like
    rolano got a reaction from Jose BN in Comentario a textbox   
    TextBox1 = Range("A7").Comment.Text Hola prueba así.
  16. Like
    rolano got a reaction from Jose BN in Comentario a textbox   
    Hola, se mas explicito, donde no te funcionó. Tienes que ver que el comentario este en la celda del código y el texbox.
  17. ¡Excelente!
    rolano reacted to bigpetroman in RECORDSET   
    Saludos @ArmandoR, prueba asi
    Option Explicit Option Base 1 Public Sub VENTAS_SECCION_MES() Dim sql As String, SheetName As String Dim AÑO, CENTRO, SECCION, MES As String Sheets("Ventas").Select AÑO = Range("C2").Value CENTRO = Range("A3").Value MES = Range("C3").Value Application.Cursor = xlWait Dim wb As Workbook, ws As Worksheet 'Venta de un año, un mes, una tienda y una sección sql = _ "SELECT SECCION, SUM(TOT_VENTAS) AS TOTAL_VENTAS " & _ "FROM PRESUPUESTO_VENTAS " & _ "WHERE ANYO = " & AÑO & " AND COD_CC = " & CENTRO & " AND MES = " & MES & " " & _ "GROUP BY SECCION" SheetName = "Ventas" Set wb = ActiveWorkbook Set ws = wb.ActiveSheet ws.Name = SheetName ' Poner los datos particulares de la conexión Dim Con As New ADODB.Connection Con.Open "provider=IBMDA400;data source=172.16.1.1;Default Collection=-------;USER ID=-----;PASSWORD=-------;" DownloadQuery Con, sql, SheetName Con.Close Set Con = Nothing Set wb = Nothing Set ws = Nothing Application.Cursor = xlDefault End Sub Private Sub DownloadQuery(Con As ADODB.Connection, sql As String, SheetName As String) Dim Cmd As ADODB.Command Dim Rs As ADODB.Recordset Dim nFilFin As Double Dim rCelda As Range Dim nSeccion As Double Set Cmd = New ADODB.Command Set Cmd.ActiveConnection = Con Cmd.CommandText = sql Dim ws As Worksheet, fld As ADODB.Field Set ws = Worksheets(SheetName) Set Rs = Cmd.Execute() nFilFin = ws.Range("A" & Rows.Count).End(xlUp).Row ' Me trae el dato de la Consulta SQL Do While Not Rs.EOF nSeccion = Rs.Fields("SECCION") 'Seccion For Each rCelda In ws.Range("A5:A" & nFilFin) If CDbl(rCelda.Value) = nSeccion Then rCelda.Offset(0, 2).Value = Rs.Fields("TOTAL_VENTAS") Exit For End If Next Rs.MoveNext Loop Set fld = Nothing Set Rs = Nothing End Sub el cambio lo realice sobre tu codigo del primer mensaje, recuerda que sin la base de datos es mas complicado, en esencia es lo mismo, realizas la consulta agrupando por SECCION y luego simplemente buscas cada SECCION en la tabla y colocas su total
     
  18. Like
    rolano got a reaction from Jose BN in RECORDSET   
    'Option Explicit Option Base 1 Public Sub VENTAS_SECCION_MES() Dim SheetName As String Dim strConectar As String Dim ws As Worksheet Dim wb As Workbook Dim Cmd As ADODB.Command Dim Rs As ADODB.Recordset Application.ScreenUpdating = False Sheets("Ventas").Select 'Range("C5").Select Application.Cursor = xlWait SheetName = "Ventas" Set wb = ActiveWorkbook Set ws = wb.ActiveSheet ws.Name = SheetName ' Poner los datos particulares de la conexión Dim Con As New ADODB.Connection Con.Open "provider=IBMDA400;data source=172.16.1.1;Default Collection=-----;USER ID=---;PASSWORD=------;" ' Dim Con As New ADODB.Connection ' strConectar = ThisWorkbook.Path & "\BDVentas.mdb" ' With Con ' .ConnectionString = _ ' "Provider=Microsoft.ACE.OLEDB.12.0" ' .Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _ ' "Data Source=" & strConectar & ";" & _ ' "Jet OLEDB:Database Password=Ventas" ' End With Set ws = Worksheets(SheetName) Set Rs = New ADODB.Recordset Rs.Open "PRESUPUESTO_VENTAS", Con, adOpenKeyset, adLockOptimistic, adCmdTableDirect ' Me trae el dato de la Consulta SQL 'ActiveCell.CopyFromRecordset Rs 'LimpiaRango ws.Range("C5:C18").ClearContents Rs.MoveFirst Do While Not Rs.EOF dFecha = Rs.Fields(12) 'Año wsFecha = Val(ws.Range("C2")) dCentro = Rs.Fields(2) 'Centro wsCentro = Val(ws.Range("A3")) dSeccion = Rs.Fields(5) 'Seccion dMes = Rs.Fields(15) 'Mes wsMes = Val(Range("C3")) For I = 5 To 18 wsSeccion = Val(Range("A" & I)) If dSeccion = wsSeccion And dMes = wsMes Then If dFecha = wsFecha And dCentro = wsCentro Then If Val(ws.Range("A" & I)) = Rs.Fields(5) Then Valor = Val(ws.Range("C" & I)) + Rs.Fields(9) ws.Range("C" & I) = Valor End If End If End If Next I Rs.MoveNext Loop Con.Close Set Rs = Nothing Set Con = Nothing Set wb = Nothing Set ws = Nothing Application.Cursor = xlDefault Application.ScreenUpdating = True End Sub Hola a todos, revisa este código adjunto, lo he corrido en un archivo de access. Tienes que ver como esta su base de datos los campos afectados deben ser números.
  19. Like
    rolano got a reaction from Jose BN in Problemas con Find   
    Hola Cecilio, adjunto el código para que lo reescribas en tu proyecto.

  20. Like
    rolano got a reaction from Jose BN in Al digitar en una celda   
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ListBox1.BoundColumn = 2 ListBox1.TextColumn = 2 Hoja3.Range("D9") = ListBox1.Value Exit Sub End Sub Hola Xanito, copia este código. Saludos @Gerson Pineda 
  21. Like
    rolano got a reaction from Jose BN in Al digitar en una celda   
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ListBox1.BoundColumn = 2 ListBox1.TextColumn = 2 Hoja3.Range("D9") = ListBox1.Value Exit Sub End Sub Hola Xanito, copia este código. Saludos @Gerson Pineda 
  22. Like
    rolano got a reaction from Jose BN in Al digitar en una celda   
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ListBox1.BoundColumn = 2 ListBox1.TextColumn = 2 Hoja3.Range("D9") = ListBox1.Value Exit Sub End Sub Hola Xanito, copia este código. Saludos @Gerson Pineda 
  23. Like
    rolano got a reaction from Antoni in NO INGRESAR DUPLICADO DE DATOS   
    Hola Sretamalb, revisa el adjunto. saludos @Antoni.
    Prueba (2).xlsm
  24. Like
    rolano got a reaction from Antoni in NO INGRESAR DUPLICADO DE DATOS   
    Hola Sretamalb, revisa el adjunto. saludos @Antoni.
    Prueba (2).xlsm
  25. Like
    rolano got a reaction from Jose BN in macro copiar pegar   
    Sub IrACataluña() ' ' IrACataluña Macro ' Ir a Cataluña ' ' Sheets("Cataluña").Select Range("C2:C5").Select Selection.Copy Range("A1").Select 'celda donde queires que se estacione. Sheets("Datos").Select Range("C2").Select ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select End Sub Sub IrAComunidadValenciana() ' ' IrAComunidadValenciana Macro ' Ir a Comunidad Valenciana Worksheets("Comunidad Valenciana").Range("C2:C6").Copy Worksheets("Datos").Range("C2") End Sub Hola, así para todas las rutinas. La segunda macro es mas corta.
×
×
  • Create New...

Important Information

Privacy Policy