Protección en VBA

hola, pepe !

... codigo que elimina las macros de un libro de una sola hoja, aqui esta: [...]
... funciona muy bien... pero... protejí el proyecto VBA y... no me borra las macros
... faltara añadir unas lineas de desproteccion para poder borrar las macros [...]

[hasta donde se] quitar contrseñas a proyectos de macros [vba]... por macros...
1° requiere 'enviar' una secuencia de teclas sendkeys al proyecto de macros...
[por omision] se esta 'afectando' ->al libro 'activo'<- [en la interfase de hojas de calculo]
2° [ademas] para estar 'en condiciones' de quitar passwords al vba de 'X' libro [en especifico]...
nos 'tendremos que' asegurar de...
- abrir el editor vba...
- cerrar TODA 'instancia' de modulo abierto...
- cerrar el editor de vba
- 'activar' el libro 'apropiado'
- 'repetir' la secuencia de teclas, pero ahora incluyendo la clave de proteccion del proyecto
3° NO 'olvidar' que, una vez 'desprotegido' un proyecto vba... ->seguira SIN password<- [en la sesion]
aun [re]protegiendolo, sera indispensable cerrarlo y abrirlo de nuevo para que 'se active' la [re]proteccion
4° [solo comentarte que] el codigo que estas usando 'elimina' TODOS los codigos [no solo el de la hoja 'activa']
[ademas de que 'le sobra' la instruccion 'ActiveSheet.Select'... estas usando ->ActiveWorkbook<-]

te pongo unos ejemplos en seguida...
saludos,
hector.
en un modulo de codigo 'normal' ==Sub Quitar_PassWord_VBA()
Application.SendKeys "%{f11}{l 4}%q", True
Workbooks("Libro X").Activate
Application.SendKeys "%{f11}^r{down}AquiTuPassWoRd~%q", True
End Sub
Sub Poner_PassWord_VBA()
Workbooks("Libro X").Activate
Application.SendKeys "%{f11}^r%hp^{pgdn}{+}{tab}AquiTuPassWoRd{tab}AquiTuPassWoRd~%q"
' la siguiente linea es ->opcional<-, puedes NO cerrarlo, pero... seguira SIN password :(
Workbooks("Libro X").Close True
End Sub

Saludos Héctor:
Gracias por tu ayuda. Te explico como actuan las macros que me has pasado.
1ª macro He insertado las linea:
Application.SendKeys "%{f11}{l 4}%q", True
Application.SendKeys "%{f11}^r{down}aquiTuPassWoRd~%q", True

sucede que me borra efectivamente las macros, pero la copia (archivo plano)
que voy a archivar, me la pone directamente en el escritorio en una carpeta
que tengo cuyo nombre es "Julio Iglesias" (curioso, eh!) .. lo he probado
varias veces y siempre me lo lleva a esa carpeta!!!... y ya está. Muy bien
pero no me deja elegir el directorio para archivarla.
2ª macro, las lineaque he insertado es:
Application.SendKeys
"%{f11}^r%hp^{pgdn}{+}{tab}AquiTuPassWoRd{tab}AquiTuPassWoRd~%q"

ahora me deja elegir el directorio para archivar pero la hoja (archivo
plano) que archivo tiene los modulos de las macros y la password del
proyecto que tenia el libro original.

Por si acaso te pongo el código completo (es una lata), pero será lo mejor
para que lo puedas analizar.
Muchisimas gracias por tu amable predisposición de siempre.

Pepe Frasquet

parcial nº 1 de todo el código
'Borra las macros
Application.SendKeys "%{f11}{l 4}%q", True
'Workbooks("Libro X").Activate
Application.SendKeys "%{f11}^r{down}jrfl0~%q", True

Set Modulos = ActiveWorkbook.VBProject.VBComponents
For Each Modulo In Modulos
Select Case Modulo.Type
Case VBExt_ct_StdModule, VBExt_ct_MSForm, _
VBExt_ct_ClassModule
Modulos.Remove Modulo
Case Else
With Modulo.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
Set Modulos = Nothing

parcial nº 2 de todo el código (en otra hoja lo tengo para probarlo)
'Borra las macros

Application.SendKeys "%{f11}^r%hp^{pgdn}{+}{tab}jrfl0{tab}AquiTuPassWoRd~%q"
Set Modulos = ActiveWorkbook.VBProject.VBComponents
For Each Modulo In Modulos
Select Case Modulo.Type
Case VBExt_ct_StdModule, VBExt_ct_MSForm, _
VBExt_ct_ClassModule
Modulos.Remove Modulo
Case Else
With Modulo.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
Set Modulos = Nothing





el código completo ahora...





'--Inicio Codigo
Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'Declaraciones 32-bit API
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

'Esta funcion muestra el dialogo para eligir directorio.
'Publicada por John Walkenbach.
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Directorio de raiz = Escritorio
bInfo.pidlRoot = 0&

' titulo en el dialogo
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' tipo de directorio a devolver
bInfo.ulFlags = &H1

' mostrar el dialogo
x = SHBrowseForFolder(bInfo)

' extraer el resultado
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub archivarhojaprevisionessemanalenmisdocumentos()
'archiva la hoja previsión en carpeta de Mis documentos
Dim msje As String
Dim MiNombre As String, MiDirectorio As String
Dim MiHoja As Worksheet, s As Worksheet
Dim Pass As String
Dim Modulo As VBIDE.VBComponent, _
Modulos As VBIDE.VBComponents
Dim carInvalidos As Variant

Dim MiArchivo As String
'***********************
Dim Insout As New Outlook.Application ' Variable objeto
Outlook
Dim Mimail As Outlook.MailItem ' Variable objeto
mensaje Outlook
Set Mimail = Insout.CreateItem(olMailItem) ' se asigna un nuevo
mensaje a la variable objeto Outlook
Dim i As Integer
Dim NombreUnico As Boolean
Dim NombreValido As Boolean

'Guarda el libro original para no perder
'los cambios accidentalmente.
ThisWorkbook.Save

'Establecemos la lista de caracteres invalidos.
carInvalidos = Array(":", "\", "/", "?", "*", "[", "]")

'Pedimos al usuario q eliga el nombre para la hoja.
MiNombre = InputBox("Nombre de la hoja", _
"PREVISIÓN VISITAS: Indicar comercial, PV y semana nº ")

If MiNombre = "" Then
MsgBox "Se ha cancelado la operacion. Nombre en blanco"

Exit Sub
'Else: MsgBox "EL NOMBRE DE LA HOJA ES " & MiNombre
End If

'comprobamos si el nombre contiene caracteres invalidos.
NombreValido = True
For i = 0 To UBound(carInvalidos)
If InStr(MiNombre, carInvalidos(i)) Then
MsgBox "El nombre " & MiNombre _
& " contiene caracteres invalidos (" _
& carInvalidos(i) & ")."
NombreValido = False
MsgBox "Se ha cancelado la operacion. Carácter inválido"
Exit Sub

Else: On Error Resume Next
End If
Next i

'Asignamos el nombre valido a la hoja.
If NombreValido = True Then _
NombreValido = MiNombre

'MsgBox "El nombre para archivar es: " & MiNombre


'Crea la variable de la hoja a copiar.
Set MiHoja = ThisWorkbook.Sheets("Previsión")
Pass = "19866381Q"
Application.ScreenUpdating = False
MiHoja.Unprotect Pass 'Desprotege
'Convierte formulas en valores, elimina las
'columnas innecesarias y activa la celda A3.
With MiHoja
.Activate
.Cells.Copy

.Cells.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
.Columns("I:IV").Clear
.Range("A3").Select
End With

'Elimina la hojas innecesarias.
Application.DisplayAlerts = False
For Each s In ThisWorkbook.Sheets
If s.Name <> MiHoja.Name Then s.Delete

Next s
Application.DisplayAlerts = True
'Borra los dibujos
'Borra botones y figuras excepto celdas de tilde y Picture1
ActiveSheet.Shapes("Button 22").Select
Selection.Delete
ActiveSheet.Shapes("Button 14").Select
Selection.Delete
ActiveSheet.Shapes("Button 15").Select
Selection.Delete
ActiveSheet.Shapes("Button 16").Select
Selection.Delete
ActiveSheet.Shapes("Button 17").Select
Selection.Delete
ActiveSheet.Shapes("Button 18").Select
Selection.Delete
ActiveSheet.Shapes("Button 19").Select
Selection.Delete
ActiveSheet.Shapes("Button 13").Select
Selection.Delete
ActiveSheet.Shapes("Button 21").Select
Selection.Delete
ActiveSheet.Shapes("Button 23").Select
Selection.Delete
ActiveSheet.Shapes("AutoShape 12").Select
Selection.Delete
ActiveSheet.Shapes("AutoShape 20").Select
Selection.Delete
'Borra las macros
Application.SendKeys "%{f11}{l 4}%q", True
'Workbooks("Libro X").Activate
Application.SendKeys "%{f11}^r{down}jrfl0~%q", True

Set Modulos = ActiveWorkbook.VBProject.VBComponents
For Each Modulo In Modulos
Select Case Modulo.Type
Case VBExt_ct_StdModule, VBExt_ct_MSForm, _
VBExt_ct_ClassModule
Modulos.Remove Modulo
Case Else
With Modulo.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
Set Modulos = Nothing


MiHoja.Name = MiNombre 'Cambia el nombre de la hoja al q se ha eligido.
'Pide al usuario q eliga el directorio para guardar el libro.
msje = "Seleccione el directorio para la copia."
MiDirectorio = GetDirectory(msje)

'Si se ha eligido un directorio guarda el libro ahi.
If MiDirectorio <> "" Then
ThisWorkbook.SaveAs MiDirectorio & "\" & MiNombre & ".xls"
MiArchivo = ThisWorkbook.path & "\" & MiNombre & ".xls"
MsgBox "Se ha guardado la copia en: " & MiDirectorio
'Si no, se guarda el libro en el director del libro original.
Else
ThisWorkbook.SaveAs ThisWorkbook.path & "\" & MiNombre & ".xls"
MiArchivo = ThisWorkbook.path & "\" & MiNombre & ".xls"
MsgBox "Se ha guardado la copia en: " & ThisWorkbook.path
End If

Application.ScreenUpdating = True


End Sub
'--Fin Codigo

hola, pepe !

para proceder con alguna [propuesta de] 'solucion'... quisiera preguntarte [solo] una 'cuestion'...
... con relacion a la [unica] hoja que vas a 'dejar' ->Sheets("Previsión")<-
¿tiene lineas de codigo o procedimientos?

¿comentas?
saludos,
hector.

[re-planteamiento de la pregunta]...

hola, pepe !

para proceder con alguna [propuesta de] 'solucion'... quisiera preguntarte [solo] una 'cuestion'...
... con relacion a la [unica] hoja que vas a 'dejar' ->Sheets("Previsión")<-
¿tiene lineas de codigo o procedimientos? <= EN SU modulo de codigo <
¿comentas?
saludos,
hector.

No, no, se queda como una hoja de excel sin formulas ni código, ni modulos.
Es una copia de la plantilla "Previsión" ó de la plantilla "Reporte"
correspondiente a la semana actual, que incluso tendrá un nombre distinto y
que queda archivada al mismo tiempo que se envia por correo electronico.
Saludos
Pepe



"Héctor Miguel" escribió en el mensaje
news:

[re-planteamiento de la pregunta]...

hola, pepe !

para proceder con alguna [propuesta de] 'solucion'... quisiera preguntarte
[solo] una 'cuestion'...
... con relacion a la [unica] hoja que vas a
'dejar' ->Sheets("Previsión")<-
¿tiene lineas de codigo o procedimientos? <= EN SU modulo de codigo <>
¿comentas?
saludos,
hector.