Excel 4.0 Macrofunciones (Macrofun)

 Excel 4.0 Macrofunciones Español e Ingles para Imprimir
macrofun.es.ro.rar en formato word (español)
macrofun.en.ro.rar en formato word (Ingles)

Trabas Contraseña usos, fechas

Contraseña 10 usos
ContraseñaDiasyVeces
ContraseñaFecha

Hoja 10 Usos

Solo se abre 10 veces luego se cierra. Hay que activar las macros.


Hoja 10 Usos

Ocultar TabHojas y Otros

Archivo para ocultar los tab de las hojas, encabezados de la hoja, otros.

Macro 4.0 OcultarTabHojasOtros

Gestión de una Biblioteca

Gestión de una Biblioteca
Biblioteca

Impedir Acciones en Excel VBA

Para evitar que durante la ejecución de una macro se vean todos
 los movimientos y cambios del cursor, para evitar las "chirivitas"
que se ven al ejecutar una macro:

Al principio de la macro escribe

    Application.ScreenUpdating = False

y al final

    Application.ScreenUpdating = True
-------------------------------------------------------------------------
Impedir que al ejecutar una macro nos haga preguntas

Al principio de la macro escribe

    Application.DisplayAlerts= False

y al final

    Application.DisplayAlerts=True

-------------------------------------------------------------------------
Impedir Abrir Libro

Sub noCopiar() 'si la ruta no es la especificada
    If ThisWorkbook.Path <> _
     "E:\TUTORIALES\Excel\Execeluciones\Mis pruebas\seguridad en excel" Then
     ThisWorkbook.Close False 'cierra el archivo
  End If
End Sub
'adaptado de una idea de Hector Miguel
'http://groups.google.com/group/microsoft.public.es.excel/browse_thread/thread/8fac1f6391126228/74d7b0fbb1e9828d?hl=es#74d7b0fbb1e9828d
'requiere el uso obligatorio de habilitar macros
-------------------------------------------------------------------------

 Impedir cambio de nombre a la hoja '
Private Sub Worksheet_Deactivate()
  If Hoja1.Name <> "Normal" Then Hoja1.Name = "Normal"
End Sub

-------------------------------------------------------------------------
Impedir Guardar Como

Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lReply As Long
If SaveAsUI = True Then
lReply = MsgBox("Lo siento, no le está permitido salvar este" & " " & "libro con otro nombre ó extensión. ¿Desea guardar este" & " " & "libro de trabajo?", vbQuestion + vbOKCancel)
Cancel = (lReply = vbCancel)
If Cancel = False Then Me.Save
Cancel = True
End If
End Sub

Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim lReply As Long
  If SaveAsUI = True Then
      lReply = MsgBox("Lo siento, No tiene permiso para guardar este libro con otro nombre. " _
                     & "¿Desea guardarlo con el mismo nombre?.", vbQuestion + vbOKCancel)
     Cancel = (lReply = vbCancel)
   If Cancel = False Then Me.Save
     Cancel = True
  End If
End Sub

-------------------------------------------------------------------------

Impedir Imprimir
Private Sub workbook_BeforePrint(Cancel As Boolean)
    Cancel = True
    MsgBox "Lo siento, No puede imprimir este libro", vbInformation
End Sub

Private Sub workbook_BeforePrint(Cancel As Boolean)
    Select Case ActiveSheet.Name
        Case "Sheet1", "Sheet2"
            Cancel = True
            MsgBox "Lo siento, No puede imprimir esta hoja de este libro", vbInformation
    End Select
End Sub

-------------------------------------------------------------------------


Impedir Vista Previa Imprimir
Private Sub Workbook_BeforePrint(Cancel As Boolean)

Cancel = True

End Sub
-------------------------------------------------------------------------


Impedir Inserte Hojas
Private Sub Workbook_NewSheet(ByVal Sh As Object)
 Application.DisplayAlerts = False
    MsgBox "Lo siento, No puede añadir nuevas hojas de calculo a este libro", vbInformation
    Sh.Delete
 Application.DisplayAlerts = True
End Sub




-------------------------------------------------------------------------
Ultima Columna Ocupada y Libre
uc = Cells(1, 255).End(xlToLeft).Column 
 uc = Cells(1, 255).End(xlToLeft).Column + 1 
lastRow = Hoja1.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
-------------------------------------------------------------------------
Ultima Fila Ocupada y Libre
LastRow = MiHoja.Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRowColA = Hoja2.Range("A65536").End(xlUp).Row
LastRow = Hoja2.Cells.SpecialCells(xlCellTypeLastCell).Row
filalibre = Range("A1").End(xlDown).Offset(1, 0).Row 
filalibre = ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Row  'Select
filalibre = ActiveSheet.Range("A1", ActiveSheet.Range("A65536")).End(xlUp).Select 
filalibre = ActiveSheet.Range("A1" & ActiveSheet.Range("A65536")).End(xlUp.Address).select 
strfila$ = Sheets("Hoja2").[A65536].End(xlUp).Offset(1, 0).Row

Sub FinalLista()
Worksheets("Socios").Select
Range("A1").Select
While ActiveCell.Value <> ""
   ActiveCell.Offset(1, 0).Range("A1").Select
Wend
End Sub

-------------------------------------------------------------------------
SubFinalLista1()
       Sheets("Socios").Activate
       Sheets("Socios").Range("A1").Select
    Do While ActiveCell <> Empty
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub

Sub UltimoReg1()

i = 1
While Worksheets("Hoja3").Cells(i, 1).Value <> ""

    Worksheets("Hoja3").Cells(i, 1).Select
    i = i + 1

Wend

End Sub

Abrir Archivo con Cuadro de Dialogo

Application.Dialogs(xlDialogOpen).Show
-------------------------------------------------------------------------
Dim archivo As String
archivo = Application.GetOpenFilename
 ------------------------------------------------------------------------
Dim FileNames As Variant
FileNames = Application.GetOpenFilename _
          ("Archivos Excel (*.xls), *.xls", , "Seleccionar archivos ", MultiSelect:=True)
-------------------------------------------------------------------------
    Dim ruta
    ruta = Application.GetOpenFilename(Title:="Selecciona la Base de Datos Origen", MultiSelect:=False)
-------------------------------------------------------------------------
Dim wkbnombre
wkbnombre = Application.GetOpenFilename("Archivos de Excel (*.xls; *.xlsx),*.xls;*.xlsx")
-------------------------------------------------------------------------
With Application.FileDialog(msoFileDialogFilePicker)
     .AllowMultiSelect = False
    .Title = "Seleccionar el libro cuyas fórmulas se quieren analizar"
    .Filters.Add "", "*.xls", 1
    .InitialView = msoFileDialogViewDetails
    .InitialFileName = ThisWorkbook.Path & "\*.xls"
    .Show
     Text1 = .SelectedItems(1)
End With

Propiedad FileDialog
Devuelve un objeto FileDialog que representa una instancia del cuadro de diálogo de archivo.
expresión.FileDialog(fileDialogType)
expresión      Requerida. Expresión que devuelve uno de los objetos de la lista Aplicar a.
fileDialogType     MsoFileDialogType requerido. Tipo del cuadro de diálogo de archivo.
MsoFileDialogType puede ser una de estas constantes MsoFileDialogType. 
msoFileDialogFilePicker  Permite al usuario seleccionar un archivo. 
msoFileDialogFolderPicker  Permite al usuario seleccionar una carpeta. 
msoFileDialogOpen  Permite al usuario abrir un archivo. 
msoFileDialogSaveAs  Permite al usuario guardar un archivo.

Abrir Archivo

Sub  AbrirLibro()
    Workbooks.Open ("C:\Mis documentos\Ejemplo.xls")
End Sub 
-------------------------------------------------------------
Sub Abrir()
    Application.EnableEvents = True
    Workbooks.Open Filename:="c:\Directorio\MiLibro.xls", UpdateLinks:=False
End Sub
-------------------------------------------------------------
Sub Abrir()
    Dim Libro As Workbook
    Set Libro = Workbooks.Open(Filename:="C:\Directorio\Libro.xls", Password:="qaz", WriteResPassword:="qaz")
End Sub
-------------------------------------------------------------
Workbooks.Open Filename:="D:\Cesar\Excel\Ejemplo.xls", Password:="123"
---------------------------------------------------------
Workbooks.Open Filename:="C:\Modulo Clase\Ejemplo.xls"
-------------------------------------------------------------

Sumar Dos Numeros

Otro Archivo de Juan Carlos (Neverdelimon1)
SumarDosNumerosMacrofuncion

Concatenar

Archivo de Juan Carlos (Neverdelimon1)
ConcatenarMacroFun-nvr

Macrofuncion

MacroFuncion, alt + F8 para activar.
Test

Ajustar Textos en Celdas Combinadas

Archivos para ajustar textos en celdas combinadas

AjustarAutomaticamenteCeldasCombinadasAltofila
AjustarTextoEnCeldasCombinadas

Autor : KL AutoFitMergedCellRowHeight
Traducido al castellano César : (AjustarAutomáticamenteCeldasCombinadasAltofila)
Autor: José Ramón García Campos (http://www.jrgc.es/) AjustarTextoEnCeldasCombinadas