............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Introducir una función externa

Ver el tema anterior Ver el tema siguiente Ir abajo

Introducir una función externa

Mensaje por Esgrimidor el Lun Mar 03, 2014 11:22 am

Introducir una función externa


En excel 2010
Cómo introduzco, paso a paso, esta macro-función.
Lo que intento es programador-macros-nombre de la macro-crear
y luego pego el contenido de la función. No me funciona bien.

La función es :

Código:
Public Function SortWorksheetsByName(ByVal FirstToSort As Long, _
                            ByVal LastToSort As Long, _
                            ByRef ErrorText As String, _
                            Optional ByVal SortDescending As Boolean = False, _
                            Optional ByVal Numeric As Boolean = False) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SortWorksheetsByName
' This sorts the worskheets from FirstToSort to LastToSort by name
' in either ascending (default) or descending order. If successful,
' ErrorText is vbNullString and the function returns True. If
' unsuccessful, ErrorText gets the reason why the function failed
' and the function returns False. If you include the Numeric
' parameter and it is True, (1) all sheet names to be sorted
' must be numeric, and (2) the sort compares names as numbers, not
' text.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim M As Long
Dim N As Long
Dim WB As Workbook
Dim B As Boolean

Set WB = Worksheets.Parent
ErrorText = vbNullString

If WB.ProtectStructure = True Then
    ErrorText = "Workbook is protected."
    SortWorksheetsByName = False
End If
   
'''''''''''''''''''''''''''''''''''''''''''''''
' If First and Last are both 0, sort all sheets.
''''''''''''''''''''''''''''''''''''''''''''''
If (FirstToSort = 0) And (LastToSort = 0) Then
    FirstToSort = 1
    LastToSort = WB.Worksheets.Count
Else
    '''''''''''''''''''''''''''''''''''''''
    ' More than one sheet selected. We
    ' can sort only if the selected
    ' sheet are adjacent.
    '''''''''''''''''''''''''''''''''''''''
    B = TestFirstLastSort(FirstToSort, LastToSort, ErrorText)
    If B = False Then
        SortWorksheetsByName = False
        Exit Function
    End If
End If

If Numeric = True Then
    For N = FirstToSort To LastToSort
        If IsNumeric(WB.Worksheets(N).Name) = False Then
            ' can't sort non-numeric names
            ErrorText = "Not all sheets to sort have numeric names."
            SortWorksheetsByName = False
            Exit Function
        End If
    Next N
End If

'''''''''''''''''''''''''''''''''''''''''''''
' Do the sort, essentially a Bubble Sort.
'''''''''''''''''''''''''''''''''''''''''''''
For M = FirstToSort To LastToSort
    For N = M To LastToSort
        If SortDescending = True Then
            If Numeric = False Then
                If StrComp(WB.Worksheets(N).Name, WB.Worksheets(M).Name, vbTextCompare) > 0 Then
                    WB.Worksheets(N).Move before:=WB.Worksheets(M)
                End If
            Else
                If CLng(WB.Worksheets(N).Name) > CLng(WB.Worksheets(M).Name) Then
                    WB.Worksheets(N).Move before:=WB.Worksheets(M)
                End If
            End If
        Else
            If Numeric = False Then
                If StrComp(WB.Worksheets(N).Name, WB.Worksheets(M).Name, vbTextCompare) < 0 Then
                    WB.Worksheets(N).Move before:=WB.Worksheets(M)
                End If
            Else
                If CLng(WB.Worksheets(N).Name) < CLng(WB.Worksheets(M).Name) Then
                    WB.Worksheets(N).Move before:=WB.Worksheets(M)
                End If
            End If
        End If
    Next N
Next M

SortWorksheetsByName = True

End Function


Gracias

Esgrimidor

Masculino Cantidad de envíos : 57
Edad : 49
Ciudad - Pais : Santa Cruz de Tenerife
Version de Excel : XP
Fecha de inscripción : 28/06/2009

Volver arriba Ir abajo

Re: Introducir una función externa

Mensaje por renem el Lun Mar 10, 2014 3:42 pm

Veamos si resulta:

1.- Abres Excel.
2.- Alt + F11
3.- Menu > Insert > Module
4.- Pegas el código
5.- Al final agrega:
Código:
Sub Mi_funcion
....aquí llamas a la función
End Sub
6.- Finalmente vas a Programador > Macro y ejecutas Mi_funcion

renem

Cantidad de envíos : 82
Ciudad - Pais : Santiago - Chile
Fecha de inscripción : 05/11/2008

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.