sábado, 4 de octubre de 2014

Titulo de la primera linea word a pdf

Hola:

Respondiendo a este post:




http://www.ayudaexcel.com/foro/thre...titulo-en-la-primera-linea.36187/#post-175982
CÓDIGO:
Sub GrabarApdf()
    Dim titulo As Variant
    Dim intLineas As Integer
   
     Selection.HomeKey wdStory
    intLineas = Selection.HomeKey & Selection.EndKey

    For i = 0 To intLineas

    Set titulo = ActiveDocument.Range(Start:=0, End:=i)

    Next i

    titulo = Replace(titulo, Chr(13), "")
   
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
         ActiveDocument.Path & "\" & titulo & ".pdf", ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

'ActiveDocument.Path & “” & ActiveDocument.Name & “.pdf”

End Sub
Titulo de la primera linea word a pdf

sábado, 2 de junio de 2012

Quitar Contraseña VBA Excel 2007-2010

Quitar Contraseña VBA Excel 2007-2010

Quitar Contraseña Excel 2007-2010

1. Herramientas necesarias winzip y Notepad++ o editor hexadecimal
Opción 1.a
(El archivo XLSM le vamos a cambiar la extensión a .ZIP)

2. Abrimos el ZIP y solo descomprimimos el archivo vbaProject.bin que
esta dentro de la carpeta XL o como en el video los archivos estan todos juntos
se tiene que descomprimir (extraer)

3. Abrimos el Notepad++ o editor hexadecimal y buscamos la siguiente palabra DPB= y la sustituimos por DBx=

4. Guardamos el archivo con la misma extensión .BIN y lo volvemos agregar al
zip sustituyendo el mismo archivo

5. Cerramos el winzip y Notepad++ o editor hexadecimal
opcion 5.a
Cambiamos nuevamente la extensión del archivó por XLSM

6 Abrimos el archivo nos vamos al proyecto y en propiedades le cambiamos
la contraseña al proyecto

7. Lo guardamos, cerramos el archivo lo volvemos abrir y nos vamos
a visual ponemos nuestra contraseña y listo adiós protección
Programa Notepad PlusPlusPortable
o
WinHex Editor Hexadecimal

Ver Video

Video Quitar Contraseña VBA Excel 2007-2010

sábado, 24 de marzo de 2012

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



miércoles, 14 de marzo de 2012

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"
-------------------------------------------------------------