Jump to content

Antoni

Members
  • Content Count

    9,964
  • Joined

  • Last visited

  • Days Won

    513

Everything posted by Antoni

  1. Prueba el adjunto. Distribucion de ordenada de fechas segun dia.xlsm
  2. Y además, la solución con la que se ha quedado contradice su consulta inicial, ya que esta solicitaba un Array. 🙁
  3. Observa que he cambiado los nombres a los rectángulos. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$14" Then ActiveSheet.Shapes("LARGA").Visible = False ActiveSheet.Shapes("CORTA").Visible = False If Target > 32 Then ActiveSheet.Shapes("LARGA").Visible = True Else ActiveSheet.Shapes("CORTA").Visible = True End If End If End Sub
  4. TextBox4 = Evaluate("=" & TextBox1 & "*" & TextBox2 & "*" & TextBox3)
  5. Después de pulsar en el enlace, puede que te aparezca una pantalla de login a Dropbox, pero puedes obviarla en la parte inferior de dicho login. Verás el nombre del archivo en la parte izquierda, NO LO PULSES. Puedes descargar el archivo pulsando un enlace en la parte superior derecha de la pantalla. De todas forma he subido el archivo al otro foro donde hiciste la consulta. Consulta en todoexcel.com
  6. ¿Y pretendes que sin la base de datos Access y sin el archivo Excel te ayude alguien? ☹️
  7. Abre el adjunto y pulsa sobre el cubilete. 🙂 https://www.dropbox.com/s/2vhno1pjybpa82f/Poker II.rar?dl=0
  8. Creo que ya lo tengo, mañana lo pruebo a fondo y lo subo.🙂
  9. No te prometo nada, pero mañana, si tengo tiempo, le echaré un vistazo a ver si podemos solucionarlo. En cualquier caso te diré algo.
  10. Sin el archivo con la macro es imposible ayudarte.
  11. Sub GuardarHistórico() For x = 2 To Hoja2.Range("A" & Rows.Count).End(xlUp).Row Set celda = Hoja1.Columns("A").Find(Hoja2.Range("C" & x), , , xlWhole) If celda Is Nothing Then Hoja1.Range("A" & Rows.Count).End(xlUp).Offset(1) = Hoja2.Range("C" & x) End If Next End Sub
  12. Solo 2 cosas: El combobox no era ActiveX, ahora si. Las celdas con fórmula no activan el evento Worksheet_Change(). AYUDA EXCEL.xlsm
  13. No siempre es necesario.
  14. Revisa el adjunto. colocar fechas laborables segun seleccion del mes AyE2.xlsm
  15. Esta macro hace lo que pides, o eso creo. El resultado se obtiene sobre la propia hoja Data. Sub AsignarCupones() Dim Data, Cupones, Fila '-- Application.ScreenUpdating = False Set Data = Sheets("Data") Set Cupones = Sheets("Cupones") '-- Fila = 1 For x = 2 To Data.Range("A" & Rows.Count).End(xlUp).Row Data.Range("D" & x) = "" For y = 1 To Data.Range("C" & x) Fila = Fila + 1 Data.Range("D" & x) = Data.Range("D" & x) & ";" & _ Cupones.Range("A" & Fila) Next Data.Range("D" & x) = Mid(Data.Range("D" & x), 2) Next End Sub '--
  16. Primero no soy Gerson(No jerson), soy Antoni y si aplica. Otra cosa distinta es que no sepas como. existencias Gerson Pineda.xlsm
  17. Prueba ahora. Prueba rango a jpg (1).xlsm
  18. Te adjunto un archivo en el que funciona correctamente. Abre el archivo y pulsa sobre la flecha azul. Abre la imagen Prueba.jpg, Prueba rango a jpg.xlsm
  19. Las fechas, tal como se ven, no dejan de ser números formateados y lo que tu planteas ocasionará que esas fechas pasen a ser texto, por lo que no vas a poder operar con ellas. Sub Macro1() For Each celda In Range("F5:F12") celda.Value = Format(celda, "dd.mm.yyyy") Next End Sub
  20. Alguna vez me he encontrado con problemas a la hora de pegar imágenes en gráficos, así no hay problema. '-- Sub Macro3() CrearImagenRango ActiveSheet.UsedRange, "Prueba" End Sub '-- Private Sub CrearImagenRango(RANGO As Range, IMAGEN As String) Application.ScreenUpdating = False 'Creamos la imagen del rango y la pegamos en la hoja RANGO.CopyPicture Appearance:=xlScreen, Format:=xlPicture ActiveSheet.Paste 'Copiamos la imagen del rango y la eliminamos ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Copy ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete 'Añadimos el gráfico y lo redimensionamos ActiveSheet.Shapes.AddChart.Select With Selection .Height = RANGO.Height .Width = RANGO.Width .Top = RANGO.Top .Left = RANGO.Top End With With ActiveSheet.Shapes(ActiveSheet.Shapes.Count) .Line.Visible = msoFalse .Fill.ForeColor.RGB = Range("A1").Interior.Color End With 'Pegamos la imagen del rango en el gráfico ActiveChart.ChartType = xlColumnClustered ActiveChart.Paste 'Exportamos el gráfico como .jpg y lo eliminamos archivo = ThisWorkbook.Path & "\" & IMAGEN & ".jpg" ActiveChart.Export Filename:=archivo, Filtername:="JPG" ActiveChart.Parent.Delete End Sub
  21. No es buena idea que personalices las consultas. Sustituye tu procedimiento por este: Private Sub CommandButton1_Click(): On Error Resume Next Dim Ctl As Control, Fram As Control For Each Ctl In Me.Controls If TypeOf Ctl Is MSForms.Frame Then For Each Fram In Ctl.Controls If TypeOf Fram Is MSForms.OptionButton Then If Fram.Value = True Then With Hoja2 vuf = .Range("B" & .Rows.Count).End(xlUp).Row + 1 .Cells(vuf, "B") = TextBox1 .Cells(vuf, "C") = TextBox2 .Cells(vuf, "D") = Ctl.Caption & " / " & Fram.Caption Select Case Ctl.Caption Case "Buzo Papel": .Cells(vuf, "E") = "00100" Case "Guantes": .Cells(vuf, "E") = "00101" Case "Antiparras": .Cells(vuf, "E") = "00102" Case "Lentes de Seguridad": .Cells(vuf, "E") = "00103" Case "Filtros": .Cells(vuf, "E") = "00104" Case "Mascarilla": .Cells(vuf, "E") = "00105" Case "Calzado de Seguridad": .Cells(vuf, "E") = "00106" End Select End With Fram.Value = False End If End If Next End If Next End Sub
  22. Esta macro lo hace todo de una vez: Sub INTERVALOS_NO_UTILIADOS() Dim MES As Date Dim INF As Worksheet Dim AUX As Worksheet Dim CON As Range Dim FALTA As String '-- Set INF = Sheets("INFO") Set AUX = Sheets("AUXILIAR") CONCETAR.CONEXION '-- Application.ScreenUpdating = False MES = Format(Month(INF.Range("E5")), "mm/dd/yyyy") For i = 12 To 26 AUX.Cells.Clear Set Rs = New ADODB.Recordset Rs.Open "Select * From [DATOS$]" & _ " Where [CO]=" & INF.Range("A1") & " And" & _ " month([Fecha])= #" & MES & "# And" & _ " [DCTO2] ='" & INF.Range("C" & i) & "'" & _ " Order By [DCTO2], [CONSECUTIVO]", Cnn, adOpenKeyset, adLockOptimistic, adCmdText AUX.Range("A1").CopyFromRecordset Rs INF.Range("D" & i) = WorksheetFunction.Min(AUX.Columns("F")) INF.Range("E" & i) = WorksheetFunction.Max(AUX.Columns("F")) INF.Range("F" & i) = "" INF.Range("F" & i) = (INF.Range("E" & i) - INF.Range("D" & i)) _ - AUX.UsedRange.Rows.Count + 1 INF.Range("G" & i) = "" FALTA = "" If INF.Range("F" & i) > 0 Then For x = INF.Range("D" & i) To INF.Range("E" & i) Set CON = AUX.Columns("F").Find(x, , , xlWhole) If CON Is Nothing Then FALTA = ", " & x & FALTA Next INF.Range("G" & i) = Mid(FALTA, 3) End If If INF.Range("F" & i) = 0 Then INF.Range("F" & i) = "" Next i End Sub
  23. Adjunto enlace del archivo. Casillas Lo borraré en una semana.
  24. Le he asignado la macro a todas las casillas de verificación. La contraseña es 123. Sub Cumple() Dim Casilla As CheckBox For Each Casilla In ActiveSheet.CheckBoxes If Casilla.Name = Application.Caller Then If Casilla.Value = -4146 Then Casilla.Value = 1 If Application.InputBox("Contraseña") = "123" Then Casilla.Value = -4146 End If End If Next End Sub
  25. Ya deberías saber que sin tu archivo y explicando lo que quieres con un ejemplo, no va a haber respuesta.
×
×
  • Create New...

Important Information

Privacy Policy

Ayuda Excel - Madrid, Madrid, ES - Valorada por 6254 personas - Aprender Excel - Total: 4.7 / 5