como eliminar macros
Jos� Rafael
as� poder archivar una hoja "plana" del mismo.
El c�digo que pongo no me funciona.
'Borra las macros
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
Jos� Rafael
Dim Modulo As VBIDE.VBComponent, _
Modulos As VBIDE.VBComponents
saludos
"Jos� Rafael" <pepe...@arrakis.es> escribi� en el mensaje
news:eefgEmwH...@TK2MSFTNGP05.phx.gbl...
David
Muy interesante tu post. Te doy algunas ideas:
Primero,
No agregues este código al libro al cual deseas "limpiar" de código, pues se
eliminaría a sí mismo, y podría generar conflictos. Te sugeriría crear un
libro aparte, y en el código del mismo puedes usar la instrucción:
Application.Dialogs(xlDialogOpen).Show
para abrir el archivo que necesitas limpiar.
Segundo,
No puedes eliminar los módulos de los objetos de Excel (ThisWorkbook,
Sheet1, etc.), pero sí puedes eliminar todas sus líneas. Considera algo como
lo siguiente:
if modulo.type = 100 then 'Tipo de los módulos de los objetos
Microsoft Excel
modulo.codemodule.deletelines _
startline:=1, _
count:=modulo.codemodule.countoflines
end if
Tercero,
para los otros tipos de módulo, creo que estás usando mal el método Remove.
Prueba con algo como:
modulos.remove modulos(modulo.name)
Esperamos tus comentarios para saber cómo te fue (espero que bien) y ver si
podemos apoyarte en algo más.
Saludos cordiales...
- - - - - -
"José Rafael" escribió:
> perdón, me faltaba comunicar los Dim:
>
> Dim Modulo As VBIDE.VBComponent, _
> Modulos As VBIDE.VBComponents
>
> saludos
>
>
> "José Rafael" <pepe...@arrakis.es> escribió en el mensaje
> news:eefgEmwH...@TK2MSFTNGP05.phx.gbl...
> > Me gustaría obtener una rutina de código para eliminar macros de un libro
> > y así poder archivar una hoja "plana" del mismo.
> > El código que pongo no me funciona.
Rafa
entiendo bien como proceder con tus instrucciones. Lo que necesitar�a es una
rutina completa de borrado de modulos para incluirla en el codigo que tengo
con el que "extraigo" una copia de una hoja de un libro pero que no queda
plana sino que se queda con una copia de todos los modulos del libro y por
eso necesito borrarlos para archivar dicha copia.
Gracias por tu ayuda.
Saludos
Jose Rafael
"David" <sdgm04Q...@hotmail.com> escribi� en el mensaje
news:C875CF32-0AB4-431F...@microsoft.com...
> Hola, Jos� Rafael.
>
> Muy interesante tu post. Te doy algunas ideas:
>
> Primero,
> No agregues este c�digo al libro al cual deseas "limpiar" de c�digo, pues
se
> eliminar�a a s� mismo, y podr�a generar conflictos. Te sugerir�a crear un
> libro aparte, y en el c�digo del mismo puedes usar la instrucci�n:
>
> Application.Dialogs(xlDialogOpen).Show
>
> para abrir el archivo que necesitas limpiar.
>
>
> Segundo,
> No puedes eliminar los m�dulos de los objetos de Excel (ThisWorkbook,
> Sheet1, etc.), pero s� puedes eliminar todas sus l�neas. Considera algo
como
> lo siguiente:
>
> if modulo.type = 100 then 'Tipo de los m�dulos de los objetos
> Microsoft Excel
> modulo.codemodule.deletelines _
> startline:=1, _
> count:=modulo.codemodule.countoflines
> end if
>
> Tercero,
> para los otros tipos de m�dulo, creo que est�s usando mal el m�todo
Remove.
> Prueba con algo como:
>
> modulos.remove modulos(modulo.name)
>
> Esperamos tus comentarios para saber c�mo te fue (espero que bien) y ver
si
> podemos apoyarte en algo m�s.
>
> Saludos cordiales...
>
> - - - - - -
>
>
> "Jos� Rafael" escribi�:
>
> > perd�n, me faltaba comunicar los Dim:
> >
> > Dim Modulo As VBIDE.VBComponent, _
> > Modulos As VBIDE.VBComponents
> >
> > saludos
> >
> >
> > "Jos� Rafael" <pepe...@arrakis.es> escribi� en el mensaje
> > news:eefgEmwH...@TK2MSFTNGP05.phx.gbl...
> > > Me gustar�a obtener una rutina de c�digo para eliminar macros de un
libro
> > > y as� poder archivar una hoja "plana" del mismo.
> > > El c�digo que pongo no me funciona.
Jos� Rafael
�Me puedes ayudar?
saludos.
Jos� Rafael
"Rafa" <pepefra...@arrakis.es> escribi� en el mensaje
news:%2381AwUL...@TK2MSFTNGP04.phx.gbl...
H�ctor Miguel
> ... necesitaria... una rutina completa de borrado de modulos para incluirla en el codigo que tengo
> con el que "extraigo" una copia de una hoja de un libro pero que no queda plana sino que
> se queda con una copia de todos los modulos del libro y por eso necesito borrarlos para archivar dicha copia.
1) como es el codigo con el que "extraes" una COPIA de una hoja de un libro ?
2) cuales son "todos los modulos del libro" con los que dicha COPIA (de una hoja) "se queda" ?
(en teroria:) si solo copias una hoja (de un libro a otro) y ese hoja tiene codigo en "su modulo"...
solo necesitas eliminar/borrar/... el codigo de esa hoja EN EL LIBRO a donde la has copiado (?)
saludos,
hector.
Jos� Rafael
Te paso todo el c�digo para hacer una copia de una hoja de un libro y
guardarla en el directorio que elija.
Este c�digo creo recordar que es una parte del sr. Walkenbach y otra de KL,
incluso creo que esn su d�a tambien participaste?. Ahora estoy intentando
aplicarlo al nuevo programa de trabajo de mis comerciales.
Todo me funciona bien salvo el borrado de macros que efectivamente SOLO ha
de hacerse en la copia...
Gracias por tu tiempo.
Jos� Rafael
'--------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 archivarhojareporteenmisdocumentos()
'archiva la hoja de reporte 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
Application.Run _
"'Programa de reportes y visitas para 2.009.xls'!informesemanal"
'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("Reporte")
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 7").Select
Selection.Delete
ActiveSheet.Shapes("Button 8").Select
Selection.Delete
ActiveSheet.Shapes("Button 9").Select
Selection.Delete
ActiveSheet.Shapes("Button 14").Select
Selection.Delete
Range("E1").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
'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
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------
"H�ctor Miguel" <NOhemio...@PLShotmail.com> escribi� en el mensaje
news:%23TYe4b6...@TK2MSFTNGP04.phx.gbl...
H�ctor Miguel
> Te paso todo el codigo para hacer una copia de una hoja de un libro y guardarla en el directorio que elija.
OJO: el codigo que expones NO hace una copia de una hoja de un libro a otro, lo que hace es...
- "prepara" un libro existente para ELIMINAR las hojas "sobrantes" y hacerle un "guradar como..."
- aun eliminadas las hojas sobrantes, elimina los modulos de codigo y el codigo en los modulos "de clase"
aunque esta parte ya la debes conocer (la transcribo de consultas anteriores solo por si las dudas)
Requiere: establecer una referencia (en vba) a la libreria (Microsoft Visual Basic for Applications Extensibility)
Pros: confiable ???
Cons: la version (numero) de la libreria depende de la version (de excel) donde se ha de utilizar (p.e.)
1) en excel 97 => NO DEBE tener numero de version.
2) en excel 2K => debiera funcionar sin problemas
3) en excel XP => REQUIERE (ademas) de un ajuste (en caso de no tenerlo ya) a las fuentes de confianza
este ajuste es desde (menu:) herramientas / macros / seguridad / (ficha) fuentes de confianza y ...
poner una marca en: confiar en el acceso a proyectos de visual basic
y ya "entrando en materia"... en tu procedimiento: => Sub archivarhojareporteenmisdocumentos(), tienes (para mi gusto):
- demasiadas lineas/variables/instrucciones/... que no son (absolutamente) necesarias
- algunas variables para OutLook que no se utilizan (no se que haga el procedimiento al que llamas en el otro libro ???)
- tampoco se aprecia el "por que" debes borrar TODAS las columnas "sobrantes" (I:IV) -???-
- y no me queda muy claro que pasa cuando hay errores o cancelaciones al definir "MiNombre" y "MiDirectorio" -???-
y como no me gusta "pedalear sobre bicicletas ajenas", te paso algunos "tips" acerca del como lo haria yo (?)
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.
' la siguiente instruccion copia la hoja "reporte" como libro nuevo (aun sin nombre) _
de una sola hoja y se quedan como la hoja activa del libro activo
ThisWorkbook.Worksheets("reporte").Copy
' ahora, podemos trabajas con la hoja activa (reporte) del libro activo (aun sin nombre)
With ActiveSheet
' desprotegemos la hoja '
.Unprotect "19866381Q"
' eliminamos los botones indicados '
.Shapes.Range(Array("button 7", "button 8", "button 9", "button 14")).Delete
' borramos las columnas de tu codigo original '
.Coumns("i:iv").Clear: Debug.Print .UsedRange.Address
' convertimos formulas a valores '
.UsedRange.Value = .UsedRange.Value
' aplicamos la formula =hoy() '
.Range("e1").Formula = "=today()"
' asignamos a la hoja el nombre '
.Name = MiNombre
End With
' y aqui seguimos trabajando sobre el libro activo (aun sin nombre)
With ActiveWorkbook
' eliminamos las lineas de codigo de "su modulo de clase" '
With .VBProject.VBComponents(ActiveSheet.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
' y guardamos el libro en "MiDirectorio" con "MiNombre" '
.SaveAs MiDirectorio & "\" & MiNombre & ".xls"
End With
__ el codigo expuesto __
Jos� Rafael
He hecho las rectificaciones pertinentes seg�n tus "tips" que han sido muy
valiosos para el objetivo final.
No obstante, a pesar de que funciona, en la parte de guardar hay algo que
corregir porque me ha guardado bien en una ocasi�n pero si cancelo ... me
guarda todo el libro con el nombre que le digo pero ademas crea un libro
nuevo n� nn que nos se guarda.... francamente no s� donde est� el error
(quizas los if..else).
En cuanto a lo de:
> aunque esta parte ya la debes conocer (la transcribo de consultas
> anteriores solo por si las dudas)
> Requiere: establecer una referencia (en vba) a la libreria (Microsoft
> Visual Basic for Applications Extensibility)
me suena a "chino" y no me acuerdo de nada....
Bueno gracias por todo como siempre por tu inestimable ayuda y ahora
transcribo el c�digo tal y como ha quedado...
Saludos
Jos� Rafael-Valencia (Espa�a)
CODIGO ACTUAL QUE FUNCIONA CASI BIEN...(salvo el comentario de arriba)
----------------------------------------------------------------------------------------
Sub archivarhojareporte()
'archiva la hoja de reporte modificado por consejos de H�ctor el 23-08-09
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
Application.ScreenUpdating = False
'Establecemos la lista de caracteres invalidos.
carInvalidos = Array(":", "\", "/", "?", "*", "[", "]")
'Pedimos al usuario q eliga el nombre para la hoja.
MiNombre = InputBox("Nombre de la hoja", _
"REPORTE: Indicar comercial, RV 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.
ThisWorkbook.Worksheets("Reporte").Copy
With ActiveSheet
.Unprotect "jrfl0"
'ELIMINAMOS LOS BOTONES
.Shapes.Range(Array("button 1", "button 2", "button 3", "button
4")).Delete
'BORRAMOS LAS COLUMNAS innecesarias
.Columns("i:iv").Clear: Debug.Print .UsedRange.Adress
'.Range("A3").Select
'Convierte formulas en valores, elimina las
.UsedRange.Value = .UsedRange.Value
'aplicamos la formula hoy()
.Range("E1").Formula = "=TODAY()"
'asignamos la hoja el nombre
.Name = MiNombre
End With
'Borra las macros
With ActiveWorkbook
' eliminamos las lineas de codigo de "su modulo de clase"'
With .VBProject.VBComponents(ActiveSheet.Name).CodeModule
.DeleteLines 1, .CountOfLines
End With
'Selecciona directorio
msje = "Seleccione el directorio para la copia."
MiDirectorio = GetDirectory(msje)
'Si se ha eligido un directorio guarda el libro ahi.
If MiDirectorio <> "" Then
.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 directorio del libro original
Else
.SaveAs ThisWorkbook.path & "\" & MiNombre & ".xls"
MiArchivo = ThisWorkbook.path & "\" & MiNombre & ".xls"
MsgBox "Se ha guardado la copia en: " & ThisWorkbook.path
End If
End With
Application.ScreenUpdating = True
End Sub
'--------Fin Codigo------
"H�ctor Miguel" <NOhemio...@PLShotmail.com> escribi� en el mensaje
news:O$45qTCJK...@TK2MSFTNGP03.phx.gbl...
H�ctor Miguel
> ... a pesar de que funciona, en la parte de guardar hay algo que corregir porque me ha guardado bien en una ocasion
> pero si cancelo... me guarda todo el libro con el nombre que le digo pero ademas crea un libro nuevo n� nn que nos se guarda
> ... francamente no se donde esta el error (quizas los if..else)...
en la fraccion y arreglo de codigo que expones, no "se aprecia" alguna instruccion que pudiera crear otro libro que no se cierra (?)
(no tienes aun en alguna parte de tus procesos alguna llamada a una macro en otro libro como tenias originalmente ???)
haciendo pruebas con el "GetDirectory(..." tampoco encontre fallas si el usuario cancela el dialogo para seleccionar carpeta/s
por lo que el if...else...end if creo que no son causa del comportamiento que describes (?)
(creo que...) "te toca" hacer una investigacion mas a fondo con (todos ?) los procedimientos que utilizas (?)
saludos,
hector.