Antoni

Hola: Se explica por si solo. Function COMPROBAR(Rango As Range) As String '-------------------------------------------------------- 'Esta UDF, comprueba que los valores de las celdas de 'la última fila y última columna del rango, coincidan con 'el sumatorio de los valores de las celdas de sus respectivas 'filas y columnas del rango, en caso de diferencias, se añade 'un comentario con el valor calculado 'Ejemplo: ' ' Rango A3:D5, se comprueba que, ' ' A3+B3+C3=D3 ' A4+B4+C4=D4 ' A5+B6+C5=D5 ' A3+A4=A5 ' B3+B4=B5 ' C3+C4=C5 ' D3+D4=D5 ' '-------------------------------------------------------- Dim MAXROW As Double Dim MAXCOLUMN As Double Dim MINROW As Double Dim MINCOLUMN As Double Dim TOTAL As Double Dim x As Double, y As Double '-------------------------------------------------------- 'Inicializamos variables COMPROBAR = "" MAXROW = 0: MAXCOLUM = 0 MINROW = 999999: MINCOLUMN = 999999 '-------------------------------------------------------- 'Buscamos fila y columna de 1ª y última celda del rango On Error Resume Next For Each CELDA In Rango CELDA.ClearComments If CELDA.Row > MAXROW Then MAXROW = CELDA.Row If CELDA.Column > MAXCOLUMN Then MAXCOLUMN = CELDA.Column If CELDA.Row < MINROW Then MINROW = CELDA.Row If CELDA.Column < MINCOLUMN Then MINCOLUMN = CELDA.Column Next '-------------------------------------------------------- 'Si no hay rango, nos vamos If MAXROW = MINROW And MAXCOLUMN = MINCOLUMN Then Exit Function '-------------------------------------------------------- 'Cuadramos filas For x = MINROW To MAXROW TOTAL = 0 For y = MINCOLUMN To MAXCOLUMN - 1 TOTAL = TOTAL + ActiveSheet.Cells(x, y) Next y If TOTAL <> ActiveSheet.Cells(x, MAXCOLUMN) Then Beep With ActiveSheet.Cells(x, MAXCOLUMN) .AddComment .Comment.Text Text:="Sumado: " & FormatNumber(TOTAL) .Comment.Shape.Height = 20 .Comment.Shape.Width = Len(FormatNumber(TOTAL)) * 12 + 20 End With End If Next x '-------------------------------------------------------- 'Cuadramos columnas For y = MINCOLUMN To MAXCOLUMN TOTAL = 0 For x = MINROW To MAXROW - 1 TOTAL = TOTAL + ActiveSheet.Cells(x, y) Next x If TOTAL <> ActiveSheet.Cells(MAXROW, y) Then Beep With ActiveSheet.Cells(MAXROW, y) .AddComment .Comment.Text Text:="Sumado: " & FormatNumber(TOTAL) .Comment.Shape.Height = 20 'Alto .Comment.Shape.Width = Len(FormatNumber(TOTAL)) * 12 + 20 End With End If Next y End Function [/CODE] Probarla a ver que os parece. Quizás ya exista, si es así, se ruega eliminar el post. Saludos. Antoni.

Seguro que sirve. Saludos. Antoni PD: Y aunque solo exista una, también puede estar a la derecha(After) o a la izquierda(Before).

Hola _ST: Muchas gracias por tus consejos, los tendré en cuenta. Esto para que no se cansen tus dedos, jajaja Private Sub BorrarFormulario() Dim Formulario As Object Dim Boton As MSForms.CommandButton On Error Resume Next For x = __ To __ ActiveWorkbook.VBProject.VBComponents.Remove _ ActiveWorkbook.VBProject.VBComponents.Item("Userform" & x) Next x End Sub[/CODE] Saludos cordiales. Antoni.

Hola _ST: Ese es el problema, de cada tres veces, mas o menos, que ejecuto la macro con esa propiedad, dos me da el error descrito en mi último post. No sigue ninguna regla, igual funciona 5 veces seguidas que falla otras 7. Por eso opté por pasar del tema. No obstante, gracias por el interés. Hasta siempre. Antoni.

Hola Germán, me alegro que lo hayas conseguido. El valor añadido que creo que tiene este aporte es, por un lado, ver las posibilidades del objeto VBProject, y por otro lado te proporciona un formulario con una estructura creada y que se puede utilizar como formulario Menú, añadiéndole otros controles y adaptandolo a tu gusto y a y tus necesidades. Hasta otra. Salu2. Antoni.

Hola Agerman: Mirate los posts #8 y#9 que contesté a Luis. Salu2. Antoni.

Hola a todos: A Agernan: Si no me dices cual es el error que te da, no puedo ayudarte. A _ST: Como dicen las frases, "¡ La Imaginación al poder !" y "Contra gustos no hay nada escrito", me parecen muy acertadas tus apreciaciones, solo una cosa a tener en cuenta, no siempre el formulario generado se llamará Userform1, porqué si ya existe un Userform1 en el momento de generar el formulario, entonces se llamaría Userform2, y así sucesivamente. Intenté cambiar el nombre al generarlo, pero me da un error aleatorio "Error 75 no se encuentra la ruta de acceso", y lo dejé por imposible. Muchas gracias, me quedo con ProcBodyLine y ReplaceLine, metodos de CodeModule que no conocia. Saludos cordiales. Antoni.

Vamos por orden: A _ST: Gracias por las sugerencias, las estudio y te comento. A Luis: En tu archivo, posicionate encima del formulario, click y F5. Si quieres hacerlo bonito: 1º) Añade esta macro que muestra el formulario Sub MostrarFormulario() Userform1.Show End sub [/CODE] 2º) Añade una forma o una imagen 3º) Click derecho sobre el objeto, escoge Asignar macro, y escoge la macro MostrarFormulario. 4º) Pulsa sobre el objeto/imagen, y el formulario se ejecutará. [b]A Agerman[/b]: Abre el archivo que envié, verás que hay un conjunto de hojas, es solo para ver el funcionamiento de la macro, valdria cualquier otro libro. 1º) Pulsa Alt+F8 y ejecuta la macro "CrearFormularioMenú" Esta macro, genera un formulario (Userform1) como si lo hubieras hecho tu manualmente, verás que hay un botón por cada hoja del libro. 2º) Sigue la respuesta de Luis. Saludos a todos.

Hola Abraham: De acuerdo con todas tus precisiones, y con esta en especial. Se me olvidó comentar que la macro debe estar en un módulo normal. He modificado la macro para que no copie las Apis, las he declarado como Public en la propia macro con lo que no se hace necesario incluirlas en el formulario. Para que quede mas claro, adjunto un libro con el que ejecutar la macro y ver sus efectos. Libro con la macro que genera formulario de botones Gracias Abraham por tu interés. Saludos a todos.

Hola sailepati: Buena e importante observación. Gracias y saludos. Antoni.

Hola: Pienso que es un problema de seguridad. Abre Excel, Boton office\Opciones excel\Centro de confianza\Configuración de macros y activa "Confiar en el acceso al modelo de objetos de proyectos de VBA". Ata logo.

Y el texto del error debe estar de color blanco porqué no lo veo, jajaj. Estoy intentando subir una imagen con las referencias. Pincha aquí para ver las referencias

Hola Luis: Tranquilo, si soporto a mi suegra y a mi cuñada, puedo soportar cualquier cosa....jajaja. Mi versión de Extensibily tambien es la 5.3. (Voy a modificar el post) ¿ Que texto de error te da ?

Hola Luis: No, no has hecho nada mal, añade la referencia Microsoft Forms 2.0 Object Library (FM20.DLL) , y por si acaso asegurate de tener también la referencia Microsoft Visual Basic for Applications Extensibility 5.3 (No se que DLL es). Saludos. Antoni.

Hola de nuevo: Maldecireis el día que entré en este foro,, ja,ja,ja... Ahora me voy a poner un poco mas serio, últimamente he descubierto el potencial de SpecialCells, cosa que ha supuesto un gran descubrimiento para mi porqué lo desconocía. Por si os interesa ahí va un ejemplo para encontrar todas las fórmulas en la hoja hoja activa, ni que decir tiene que ActiveSheet.Cells, puede ser sustituido por cualquier rango. ' ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Select For Each Celda In Selection.Cells 'Aquí incluimos lo que hay que hacer para cada celda Next [/CODE] Pues lo mismo para: [CODE]'xlCellTypeAllFormatConditions Celdas con cualquier formato. 'xlCellTypeAllValidation Celdas con criterios de validación. 'xlCellTypeBlanks Celdas vacías. 'xlCellTypeComments Celdas que contengan notas. 'xlCellTypeConstants Celdas que contengan constantes. 'xlCellTypeFormulas Celdas que contengan fórmulas. 'xlCellTypeLastCell La última celda del rango. 'xlCellTypeSameFormatConditions Celdas que tengan el mismo formato. 'xlCellTypeSameValidation Celdas que tengan los mismos criterios de validación. 'xlCellTypeVisible Todas las celdas visibles [/CODE] Y para complementar el aporte, nada mejor que las respuestas de Maurico en: -duda-en-specialcells-type-value-11641/"]https://www.ayudaexcel.com/foro/f10/[solucionado]-duda-en-specialcells-type-value-11641/ Saludos a todos y "happy weekend". Antoni.

Hola: ¡¡ Lo he conseguido !! Me he superado a mi mismo, os adjunto el aporte mas inútil de la historia del foro. Se trata de una macro: Esta macro, crea un formulario con un botón con el nombre cada hoja .Al ejecutar el formulario, se activa la hoja con el nombre del botón .Al formulario, se le han añadido las Apis para poder minimizarlo Y ahora os preguntareis. ¿Pero eso no es exactamente lo mismo que el tab de hojas?. Pues efectivamente, es lo mismo que el tab de hojas, pero mas grande, mas feo y mas complicado. Ya se había inventado la rueda, pero yo, la he reinventado, la he hecho cuadrada, para que no haga falta ponerle freno de mano a los coches. Para probar esta maravilla del progreso humano, solo teneis que abrir cualquier libro, si puede ser con varias hojas, y hacer correr la macro "CrearFormularioMenú", luego ejecutar el formulario generado, y a pulsar botones. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Const WS_MINIMIZEBOX As Long = &H20000 Private Const WS_MAXIMIZEBOX As Long = &H10000 Private Const GWL_STYLE As Long = (-16) '------------------------------------------------- Private Sub UserForm_Initialize() Dim lngMyHandle As Long, lngCurrentStyle As Long, lngNewStyle As Long '------------------------------------------------- lngMyHandle = FindWindow("THUNDERDFRAME", "Menú general") lngCurrentStyle = GetWindowLong(lngMyHandle, GWL_STYLE) lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX 'Or WS_MAXIMIZEBOX SetWindowLong lngMyHandle, GWL_STYLE, lngNewStyle End Sub ' '¡¡¡ NO AÑADIR/QUITAR/MODIFICAR NADA ANTES DE ESTA LINEA !!! ' '-------------------------------------------------------------------- ' Esta macro, crea un formulario con un botón con el nombre cada hoja ' .Al ejecutar el formulario, se activa la hoja con el nombre del botón ' .Al formulario, se le han añadido las Apis para poder minimizarlo '-------------------------------------------------------------------- ' Sub CrearFormularioMenú() Dim Formulario As Object Dim Boton As MSForms.CommandButton '----------------------------- AÑADIMOS EL FORMULARIO ----------------- Set Formulario = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm) With Formulario .Properties("ShowModal") = False .Properties("Caption") = "Menú general" .Properties("Width") = 158 .Properties("Height") = Sheets.Count * 50 + 28 End With '------------------------------ AÑADIMOS LAS APIS ---------------- Set Desde = ActiveWorkbook.VBProject.VBComponents("Módulo1").CodeModule With ActiveWorkbook.VBProject.VBComponents(Formulario.Name).CodeModule .InsertLines .CountOfLines + 1, Desde.Lines(1, 19) End With '-------------------------------------------------------------------------- X = ActiveWorkbook.VBProject.VBComponents(Formulario.Name).CodeModule.CountOfLines + 1 For m = 1 To Sheets.Count Set Boton = Formulario.Designer.Controls.Add("forms.CommandButton.1") With Formulario '-------------- AÑADIMOS UN COMMANDBUTTON POR CADA HOJA --------------- .Designer.Controls(Formulario.Designer.Controls.Count - 1).Name = "Boton" & m .Designer.Controls(Formulario.Designer.Controls.Count - 1).Caption = Sheets(m).Name .Designer.Controls(Formulario.Designer.Controls.Count - 1).Width = 150 .Designer.Controls(Formulario.Designer.Controls.Count - 1).Height = 50 .Designer.Controls(Formulario.Designer.Controls.Count - 1).Top = 2 + 50 * (m - 1) .Designer.Controls(Formulario.Designer.Controls.Count - 1).Left = 2 '--------------- AÑADIMOS EL EVENTO CLICK PARA CADA COMMANDBUTTON ---- .CodeModule.InsertLines X, "Private Sub Boton" & m & "_Click()": X = X + 1 .CodeModule.InsertLines X, "Sheets(""" & Sheets(m).Name & """).Activate": X = X + 1 .CodeModule.InsertLines X, "End Sub ": X = X + 1 '---------------------------------------------------------------------------------- End With Next m End Sub [/CODE] Que el Señor os de paciencia para aguantarme en mi demencia. Os tengo presentes en mis oraciones. Antoni. [b][i][size=5][color=red]¡ Importante ! Ver posts Nº 10 y Nº 12[/color][/size][/i][/b]

¡¡¡ cuidado !!! Al entrar en la pagina, me da una alerta de infeccion por virus. ARCHIVO: ........\panama.js Virus indeterminado

Hola Julio: Si no te llamas Julio, ¿Como te llamas?. Un abrazo. Antoni. PD. Por lo que veo, todos tenemos unos añitos. ¿Y si montamos un geriatrico?...ja...ja

Muy bueno Julio, lástima que no se le pueda dar de verdad.

Hola Gerson: Di por supuesto que se entendería que era en Excel 2007 por el comentario que hice, pero como suponer es la mejor manera de equivocarse, he modificado el título del aporte. Gracias por la aclaración , un saludo muy cordial. Antoni.

Hola: Estoy con mi Excel 2007 como un niño con un juguete nuevo. Para eliminar filas duplicadas: ActiveSheet.Cells.RemoveDuplicates Columns:=1[/CODE] En este ejemplo eliminaremos todas las filas con duplicados en la columna 1. No es necesario ningún orden especial. Se conserva la primera fila del grupo. Saludos. Antoni.

Hola: Parece que hay algún que otro problemilla para subir archivos. Abre una cuenta en Skydrive, y podrás subir archivos de forma inmediata, mientras nuestro "SuperJuli" nos lo arregla. Salu2. Antoni.

Hola "Juli", a mi no me dan miedo tus ojos,, je,je,, De donde yo soy, Galicia, dicen que no se sabe cuando vamos o cuando venimos. Pues eso, como buen Gallego, a vece si, a veces no, pues eso es lo que me pasa al subir un archivo, que a veces lo sube y otras veces no lo sube. Hago una prueba, en este mismo momento...... Vacío la caché por si acaso......., borro el historial para asegurar el tiro....... y vamos a subir el archivo......¡¡¡ Ha funcionado !!!!, voy a probarlo otra vez, pero ahora sin red, pues también a funcionado............ No entiendo nada, esta mañana lo he intentado varias veces y no ha funcionado. ¿ Se estará volviendo gallego el foro ? Salu2, y..... seguiremos informando. Antoni. Dejo el archivo como prueba. 3CommandButton.zip

No tuve el placer de conocerle, pero siempre es una pena perder a un compañero del foro. Que su recuerdo permanezca siempre entre los que quiso y los que le quisieron.

Re: Mensajes con duración de determinada Tranquilo Abraham, en ningún momento me lo tomé como un reproche, al contrario. Saludos cordiales. Antoni.