Adicionar algunos requisitos en macro Excel
Feliz fin de semana
Nuevamente molestándote con una macro que un amigo acá en Venezuela me facilito, la cual usa el en su plantilla y yo la adapte a la mía, sobretodo el rango, nombre, ruta y la suma de I3. Esta macro ya ejecuta estos puntos descriptos abajo
Copia la hoja (rango) en .xlsx y en PDF también (ya lo hace)
Elimina TODA y cualquier macro DE LA COPIA .xlsx (ya lo hace)
No transporta las formulas del origen a la copia (ya lo hace)
Elimina todos los botones DE LA COPIA .xlsx solamente (ya lo hace).
Lo que pretendo agregarle es:
Que la copia (.xlsx) quede TOTALEMTE PROTEGIDA con clave, para que NADIE pueda modificar NADA en la copia.
Al abrir la copia por 1ª vez, se ve TODO el rango seleccionado, QUE NO SEA ASÍ
Le metí Range después de la línea Application.CutCopyMode = False para que en la copia, no se vea el rango seleccionado al abrir por 1ª vez. No sé si estará bien ubicada Range("A2").Select
En el libro origen, SI TENGO LA HOJA protegida dejando solo LAS CELDAS que realmente voy a escribir, desbloqueadas, me manda error
Le metí ActiveSheet.Unprotect = "123" al inicio y al final de la ejecución, Proteted pero, me manda error al inicio de la ejecución.
Quiero mantener la hoja origen protegida, solo las celdas donde se tiene que escribir, desbloqueadas.
¿Podrás hacer algo por esto? Si más corta con todas estas funciones mejor, si no, agregarle lo que pido.
Son varios puntos, ya se que me dirás, por eso no hay problema alguno, crearé los que fueran necesarios
Te ruego ME DIGAS si te envío el libro para que veas si puedes hacer algo por esto.
Estuve tratando de meterle líneas para algunos de los requisitos que quiero agregarle pero no fui tan tan para dar con el punto
1 Respuesta
Te anexo la macro con:
1. Copia la hoja "rango"
2. La copia sin botones
3. La copia sin fórmulas
4. Selecciona la celda A2
5. Guarda el archivo como xlsx
6. La hoja está protegida
Sub CrearHoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = 1
ruta = ThisWorkbook.Path & "\"
Sheets("rango").Cells.Copy
Workbooks.Add
ActiveSheet.[A1].PasteSpecial Paste:=xlValues
ActiveSheet.[A1].PasteSpecial Paste:=xlFormats
[A2].Select
ActiveSheet. Protect "abc"
ActiveWorkbook.SaveAs ruta & "rango.xlsx"
ActiveWorkbook. Close
End Sub
Hola DAM
Te envío el libro con 2 hojas de copias hechas, la hoja de tu macro y otra hoja de mi macro
Las macros tienen el comentario de; MI MACRO Y TU MACRO.
En el libro, en la hoja INF esta lo que quiero agregar, sea a MI MACRO, sea a TU MACRO
No me ha llegado tu correo.
Mi macro hace todo lo que pediste, ¿qué le faltaría?
Te regreso tu macro actualizada y revisada
Sub GuardaSinMacros() 'MI MACRO MI MACRO MI MACRO MI MACRO MI MACRO
Dim ruta As String
Dim nombre As String
Dim wb As Object
Dim i As Long
Dim d As String
ruta = "C:\0\1\"
ruta = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' ActiveSheet.Unprotect = "123"
With ThisWorkbook.Sheets(1)
nombre = .Range("G4") & "_" & .Range("C13") & " " & .Range("D13") & "-" & .Range("H13").Value
.Copy
End With
Set wb = Workbooks(Workbooks.Count)
With wb
With .Sheets(1)
For i = .Shapes.Count To 1 Step -1
d = .Shapes(i).TopLeftCell.Address(False, False)
Select Case d
Case "J2": .Shapes(i).Delete
Case "J3": .Shapes(i).Delete
Case "L3": .Shapes(i).Delete
End Select
Next
.SaveAs Filename:=ruta & nombre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
With .Range("B2:J60")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nombre & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
.Copy
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("A2").Select 'DEseleccionar el rango en la copia
End With
With .Cells
.Locked = True
.FormulaHidden = False
End With
.Protect Password:=1234, DrawingObjects:=True, Contents:=True, Scenarios:=True
.EnableSelection = xlNoRestrictions
End With
.SaveAs Filename:=ruta & nombre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
.Close True
End With
Set wb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
With ThisWorkbook
With .Sheets(1).Range("I3")
.Value = .Value + 1
End With
End With
' ActiveSheet.Protect = "123"
End Sub
Hola DAM
Esta protegida la hoja de copia
Será posible que esta copia quede que no se puedan seleccionar las celdas? quedar TOTALMENTE BLOQUEADA pero se pueda imprimir claro está
Creare nuevo tema para lo de la hoja origen, tal como menciono en la columna L de dicha hoja "Presupuesto", y en el punto 3 de la hoja INF porque, al protegerla, el botón me manda error creo que por lo de los botones que tiene, CREO.
Cambia esto:
.EnableSelection = xlNoRestrictions
Por esto
.EnableSelection = xlNoSelection
Voy amigo.
Ya Crie nuevo tema, responde para poder calificar
Quiero decirte que (si no te diste cuenta, creo que si pues no te pasa nada por debajo de la mesa;
Esta línea esta repetida en la macro que me dejaste
.SaveAs Filename:=ruta & nombre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
¿Alguna esta demás?
No la quites, primero hay que guardar el archivo y después ya lo puedes guardar como PDF, después se protege la hoja y se vuelve a guardar el libro.
