Jump to content

Antoni

Members
  • Posts

    11,414
  • Joined

  • Last visited

  • Days Won

    806

Everything posted by Antoni

  1. Abre el adjunto y pulsa sobre la flecha azul. Calendario (1).xlsm
  2. Aplicando la respuesta de Abraham, podría quedar así: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("J:J,O:O,T:T")) Is Nothing Then Cancel = True If Target = "" Then Target = 1 Else Target = "" End If End If End Sub
  3. Private Sub TxtImporte_Change() LblEnLetras.Caption = "" If IsNumeric(TxtImporte) Then Sheets("Auxiliar").Range("C5") = TxtImporte LblEnLetras.Caption = Sheets("Modelo").Range("A20") End If End Sub
  4. Con un control picture no es posible, no tiene esa propiedad. 😒
  5. Aquí estamos, adjunto lo prometido. La aplicación permite crear cualquier número de álbumes y cualquier número de temas por álbum. Mostrar el formulario pulsando la imagen de la hoja de presentación. Añadir un álbum escribiendo en el combo Álbum y pulsando el botón Añadir álbum. Informar el tema de álbum (Opcional) y pulsar el botón Añadir imágenes. Pasando el mouse sobre las miniaturas, aparecerá la imagen ampliada. Por supuesto, las imágenes no se guardan en la hoja, solo su dirección. Una imagen puede estar en varios álbumes. Se pueden poner descripciones a las imágenes pulsando en la lista. Mis álbumes.xlsm
  6. Mañana, si puedo, te subo un gestor de imágenes.
  7. Pues tienes razón, tu función es casi el doble de rápida que la mía. Te dejo la prueba por si quieres repetirla en tu PC. Function Contar_Color(Evaluar As Range, Modelo As Range) As Long Dim ColorModelo As Long Dim Celda As Range Contar_Color = 0 ColorModelo = Modelo.Interior.Color For Each Celda In Evaluar If Celda.Interior.Color = ColorModelo Then Contar_Color = Contar_Color + 1 Next End Function '-- Function Contar_ColorII(Evaluar As Range, Modelo As Range) As Long Dim Celda As Range For Each Celda In Evaluar If Celda.Interior.Color = Modelo.Interior.Color Then Contar_ColorII = Contar_ColorII + 1 Next End Function '-- Sub Prueba() Dim x As Long t = Timer x = Contar_ColorII(Range("A1:A500000"), Range("B1")) Debug.Print Timer - t '-- t = Timer x = Contar_Color(Range("A1:A500000"), Range("B1")) Debug.Print Timer - t End Sub
  8. Podríamos acortar un poco la función, aunque no es necesario: Function Contar_Color(Evaluar As Range, Modelo As Range) As Long Dim Celda As Range For Each Celda In Evaluar If Celda.Interior.Color = Modelo.Interior.Color Then Contar_Color = Contar_Color + 1 Next End Function
  9. Sube tu archivo y explica con un ejemplo lo que quieres hacer.
  10. Tienes un error de concepto, la función Format() no tiene nada que ver con el formato de las celdas de Excel, Excel reconoce como numérico su formato, pero no el de VBA, que lo interpreta como texto, de hecho, Excel guarda el dato como número, el formato es su visualización. Para comprobarlo solo tienes que ver una celda formateada desde Excel y luego ver lo que aparece en la barra de fórmulas, para solucionarlo, pasa el valor numérico a la celda y dale formato en Excel o usa la solución de Gerson. ejemplo: Range("A1")=Hoja2.Cells(estaen, col).Value + funcionarios(i, j)) / 60 y luego, o formateas directamente en Excel, o: Range("A1").NumberFormat = "#,##0.0"
  11. A mi esto me funciona: Private Sub Generar(Rango As Range) URL = "https://chart.googleapis.com/chart?chs=180x180&cht=qr&chld=l&chl=" & Rango.Value Set Imagen = ActiveSheet.Pictures.Insert(URL) End Sub
  12. Sub CopiarArchivo() FileCopy RutaArchivoOrigen, RutaArchivoDestino End Sub
  13. Si lo encuentra, los ceros a la izquierda no forman parte del valor de la celda. SI no lo encuentra, sube un ejemplo en un archivo Excel con los datos y la macro que o funciona.
  14. Es conveniente, tal como comenta JSDJSD, subir un archivo para poder probar las posibles soluciones. Inténtalo con esta macro. Private Sub UserForm_Initialize() ListBox1.ListStyle = fmListStyleOption For x = 5 To Sheets.Count Range("ZZ" & x - 4) = Sheets(x).Name Next Columns("ZZ").Sort Key1:=Columns("ZZ") ListBox1.List = Range("ZZ1:ZZ" & x - 5).Value Columns("ZZ").Clear End Sub
  15. Private Sub CommandButton1_Click() For x = 6 To Sheets.Count ComboBox1.AddItem Sheets(x).Name Next End Sub
  16. Y de paso: Set rango = ThisWorkbook.Sheets("LOCALIDADES").Cells(1, 1).CurrentRegion por esto: Set rango = ThisWorkbook.Sheets("LOCALIDADES").Columns("A")
  17. For j = 1 To 22: cadena = cadena & LCase(Cells(i, j)): Next 'He Cambiado 11 por 22
  18. Sub pruebas() ' Declaramos las variables... Dim miArray() As Variant 'Opción 1 miArray = Application.Transpose(Range(Cells(2, 1), Cells(2, 8)).Value) For i = 0 To UBound(miArray) - 1 msgString = msgString & miArray(i + 1, 1) & vbCr Next i ' Mostramos el contenido del array... MsgBox "Los valores del Array son los siguientes: " & vbCr & msgString End Sub
  19. Ha sido más sencillo de lo previsto. Consultar Notificaciones.xlsm
  20. A ver si durante el fin de semana tengo algo de tiempo.
  21. El proceso es algo lento. Avisa se te interesa darle otro enfoque para mejorar la velocidad. Prueba (3).xlsm
×
×
  • Create New...

Important Information

Privacy Policy