Pegado especial en celdas combinadas

Hola KL, despues de unos dias de " holidays" vuelvo a la carga.
Con unos ligeros arreglos y con tu codigo, estoy trabajando correctamente.
Las copias quedan depositadas en la intranet para consulta de los usuarios y
la cuestion que me surge es:
Es posible evitar la impresion de las hojas copiadas?
Desearia restringir los permisos de impresion a una serie de usuarios de
nuestra intranet.
Puedes adelantarme la manera de hacerlo?

Gracias de nuevo

Pablo.

"KL" wrote:

Pablo,

"Pablo" escribio..
> El problema se crea cuando alguien por error mueve alguna hoja de lugar
> dentro del libro, con lo que cambia el orden y las hojas que se copian son
> distintas.
> ?como puedo evitarlo?
> ?Como puedo copiar las hojas teniendo en cuenta su nombre y no su
> posicion?

Puedes probar este codigo.
Saludos,
KL

Private Sub CrearLibroRechazos()
Dim Hoja As Worksheet, cHojas As Variant
Dim rng As Range, Pass As String, i As Integer

'establece la lista de hojas relevantes y la contrasena para
protegerlas.
cHojas = Array("Hoja3", "Hoja4")
Pass = "Contrasena"

Application.ScreenUpdating = False
With ThisWorkbook

'copia y pega valores en las hojas relevantes.
For i = LBound(cHojas) To UBound(cHojas)
With .Worksheets(cHojas(i))
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues
.Protect Pass
Application.CutCopyMode = False
End With
Next i
Application.CutCopyMode = False

'Borra todas las hojas irrelevantes.
Application.DisplayAlerts = False
For Each Hoja In .Worksheets
On Error Resume Next
Select Case True
Case IsEmpty(WorksheetFunction.Match(Hoja.Name, cHojas, 0))
Hoja.Delete
End Select
On Error GoTo 0
Next Hoja
Application.DisplayAlerts = True

'Guarda copia del fichero.
.SaveAs ("C:\Mis Documentos\" & Right("Copia" & _
Trim(Str(Day(Now() - 1))), 10) & (Format(Now() _
- 1, "mmm") & Right(Str(Year(Now() - 1)), _
2))), , , ("GT"), True
End With
Application.ScreenUpdating = True
End Sub

Hola Pablo,

Podrias probar hacerlo por codigo, pero, claro, solo funcionara si el
usuario habilita los macros y (incluso con los macros habilitados) no se le
ocurre usar esta pequna instruccion VBA aunque sea desde la ventana
"Inmediato" del Editor VBA: Application.EnableEvents=False.
En todo caso, prueba el siguiente codigo:

1) Esta parte va a cualquier modulo normal, es decir q no sea de clase,
hoja, libro o formulario

'--Inicio Codigo
Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function ReturnUserName() As String
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = UCase(Trim(tString))
End Function
'--Fin Codigo

2) Esto va al modulo de EsteLibro (ThisWorkbook):

'--Inicio Codigo
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim UsuariosRestringidos As Variant
Dim msje As String
Dim NoAutorizado As Integer

'Pon aqui los logins reales.
UsuariosRestringidos = Array("Pedro", "Pablo", "Maria")
On Error Resume Next

'Contrastamaos el login de red contra
'la lista de usuarios no autorizados.
'No distingue entre minusc. y mayusc.
NoAutorizado = Application.WorksheetFunction.Match _
(ReturnUserName, UsuariosRestringidos, 0)
On Error GoTo 0
If NoAutorizado Then
Cancel = True
msje = "Impresion restringida." & Chr(13)
msje = msje & "Por favor, contacte con..."
MsgBox msje
End If
End Sub
'--Fin Codigo

Saludos,
KL


"Pablo" wrote in message
news:

Hola KL, despues de unos dias de " holidays" vuelvo a la carga.
Con unos ligeros arreglos y con tu codigo, estoy trabajando
correctamente.
Las copias quedan depositadas en la intranet para consulta de los usuarios
y
la cuestion que me surge es:
Es posible evitar la impresion de las hojas copiadas?
Desearia restringir los permisos de impresion a una serie de usuarios de
nuestra intranet.
Puedes adelantarme la manera de hacerlo?

Gracias de nuevo

Pablo.

"KL" wrote:

Pablo,

"Pablo" escribio..
> El problema se crea cuando alguien por error mueve alguna hoja de lugar
> dentro del libro, con lo que cambia el orden y las hojas que se copian
> son
> distintas.
> ?como puedo evitarlo?
> ?Como puedo copiar las hojas teniendo en cuenta su nombre y no su
> posicion?

Puedes probar este codigo.
Saludos,
KL

Private Sub CrearLibroRechazos()
Dim Hoja As Worksheet, cHojas As Variant
Dim rng As Range, Pass As String, i As Integer

'establece la lista de hojas relevantes y la contrasena para
protegerlas.
cHojas = Array("Hoja3", "Hoja4")
Pass = "Contrasena"

Application.ScreenUpdating = False
With ThisWorkbook

'copia y pega valores en las hojas relevantes.
For i = LBound(cHojas) To UBound(cHojas)
With .Worksheets(cHojas(i))
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues
.Protect Pass
Application.CutCopyMode = False
End With
Next i
Application.CutCopyMode = False

'Borra todas las hojas irrelevantes.
Application.DisplayAlerts = False
For Each Hoja In .Worksheets
On Error Resume Next
Select Case True
Case IsEmpty(WorksheetFunction.Match(Hoja.Name, cHojas, 0))
Hoja.Delete
End Select
On Error GoTo 0
Next Hoja
Application.DisplayAlerts = True

'Guarda copia del fichero.
.SaveAs ("C:\Mis Documentos\" & Right("Copia" & _
Trim(Str(Day(Now() - 1))), 10) & (Format(Now() _
- 1, "mmm") & Right(Str(Year(Now() - 1)), _
2))), , , ("GT"), True
End With
Application.ScreenUpdating = True
End Sub

Hola KL, buenas y frias noches desde el norte de España.
Con el código de abajo estoy creando una copia diaria de algunas hojas de un
Libro maestro.
Estas copias posteriormente se envian mediante Exchange a nuestra intranet.

En el momento de creación de las copias necesitaría insertar o exportar el
código de restricciones de impresión.
Es posible hacerlo de modo automático?





Private Sub CrearLibroRechazos()
Dim wkbOrigen As Workbook, wkbDestino As Workbook
Dim wksH As Worksheet, cHojas As Variant
Dim n As Integer

Set wkbOrigen = ThisWorkbook
Set wkbDestino = Workbooks.Add
cHojas = Array("Rechazos", "CR")
Application.ScreenUpdating = False

'Crear las hojas en el nuevo libro si hay menos de 2 _
o borrar las que excedan de dicho número.
If wkbDestino.Worksheets.Count < 2 Then
For n = wkbDestino.Worksheets.Count + 1 To 2
wkbDestino.Worksheets.Add
Next n
ElseIf wkbDestino.Worksheets.Count > 2 Then
Application.DisplayAlerts = False
For n = wkbDestino.Worksheets.Count To 3 Step -1
wkbDestino.Worksheets(n).Delete
Next n
Application.DisplayAlerts = True
End If

For n = LBound(cHojas) To UBound(cHojas)
wkbOrigen.Worksheets(cHojas(n)).Cells.Copy
With wkbDestino.Worksheets(n + 1)
' .Range("A1").PasteSpecial xlPasteValues
' .Range("A1").PasteSpecial xlPasteFormats
.Cells.PasteSpecial Paste:=xlValues
.Cells.PasteSpecial Paste:=xlFormats
.Name = wkbOrigen.Worksheets(cHojas(n)).Name
.Activate
.Range("A1").Select
.Protect Password:="Gestores"

End With
Next n

wkbDestino.SaveAs ("C:\Mis Documentos\Rechazos\" & Right("Rechazos" &
Trim(Str(Day(Now() - 1))), 10) _
& (Format(Now() - 1, "mmm") & Right(Str(Year(Now() - 1)), 2))), , ,
("GT"), True


Application.CutCopyMode = False
Application.ScreenUpdating = True

Set wksH = Nothing
Set wkbDestino = Nothing
Set wkbOrigen = Nothing


Agradezco tus respuestas tanto como el calor y la luz de Junio

Gracias de antemano
Pablo
PD. Tu código funciona correctamente

"KL" wrote:

Hola Pablo,

Podrias probar hacerlo por codigo, pero, claro, solo funcionara si el
usuario habilita los macros y (incluso con los macros habilitados) no se le
ocurre usar esta pequna instruccion VBA aunque sea desde la ventana
"Inmediato" del Editor VBA: Application.EnableEvents=False.
En todo caso, prueba el siguiente codigo:

1) Esta parte va a cualquier modulo normal, es decir q no sea de clase,
hoja, libro o formulario

'--Inicio Codigo
Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function ReturnUserName() As String
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = UCase(Trim(tString))
End Function
'--Fin Codigo

2) Esto va al modulo de EsteLibro (ThisWorkbook):

'--Inicio Codigo
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim UsuariosRestringidos As Variant
Dim msje As String
Dim NoAutorizado As Integer

'Pon aqui los logins reales.
UsuariosRestringidos = Array("Pedro", "Pablo", "Maria")
On Error Resume Next

'Contrastamaos el login de red contra
'la lista de usuarios no autorizados.
'No distingue entre minusc. y mayusc.
NoAutorizado = Application.WorksheetFunction.Match _
(ReturnUserName, UsuariosRestringidos, 0)
On Error GoTo 0
If NoAutorizado Then
Cancel = True
msje = "Impresion restringida." & Chr(13)
msje = msje & "Por favor, contacte con..."
MsgBox msje
End If
End Sub
'--Fin Codigo

Saludos,
KL

Pablo,

Como una opcion podrias incrustar el siguienete codigo dentro de tu macro.
Lo malo de este es q es muy aparatoso. Tambien es probable q al copiarlo a
tu modulo tengas q reparar algunas lineas por q habran salido
desconfiguradas. Ojo - si ya existe algun codigo asignado al evento
BeforePrint del libro de destino o existe un nombre de funcion duplicado se
abortara el procedimiento.

Saludos,
KL

'-Inicio Codigo
Option Explicit

Sub CrearModulo()
Dim WBModule As Object
Dim Modulo As Object 'VBComponent
Dim Fila As Integer
Dim x, msje As String, vbc As Object

Application.VBE.MainWindow.Visible = False

'Crea la variable para el modulo ThisWorkBook
Set WBModule =
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule

'Comprueba q no exista una funcion o variable con el mismo nombre
For Each vbc In ActiveWorkbook.VBProject.VBComponents
With vbc.CodeModule
x = .Find("GetUserName", 1, 1, .CountOfLines, 1, False, False)
If x Then
msje = "Ya existe el nombre - GetUserName" & Chr(13)
msje = msje & "No se ha podido anadir codigo!"
MsgBox msje, vbCritical + vbOKOnly, "Error Fatal"
Exit Sub
End If
x = .Find("ReturnUserName", 1, 1, .CountOfLines, 1, False,
False)
If x Then
msje = "Ya existe el nombre - ReturnUserName" & Chr(13)
msje = msje & "No se ha podido anadir codigo!"
MsgBox msje, vbCritical + vbOKOnly, "Error Fatal"
Exit Sub
End If
End With
Next vbc

'Comprueba q no exista procedimientos asignados al evento
With WBModule
x = .Find("Workbook_BeforePrint", 1, 1, .CountOfLines, 1, False,
False)
If x Then
msje = "Ya existe un procedimiento" & Chr(13)
msje = msje & "asignado al evento Workbook_BeforePrint." &
Chr(13)
msje = msje & "No se ha podido anadir codigo!"
MsgBox msje, vbCritical + vbOKOnly, "Error Fatal"
Exit Sub
End If
End With

'Crea Modulo
Set Modulo = ActiveWorkbook.VBProject. _
VBComponents.Add(1)

'Introduce el codigo
With Modulo.CodeModule
Fila = .CountOfLines
.InsertLines Fila + 1, "Public Declare Function GetUserName Lib
""advapi32.dll"" _"
.InsertLines Fila + 2, "Alias ""GetUserNameA"" (ByVal lpBuffer As
String, nSize As Long) As Long"
.InsertLines Fila + 3, "Public Function ReturnUserName() As String"
.InsertLines Fila + 4, "Dim rString As String * 255, sLen As Long,
tString As String"
.InsertLines Fila + 5, "tString = """
.InsertLines Fila + 6, "On Error Resume Next"
.InsertLines Fila + 7, "sLen = GetUserName(rString, 255)"
.InsertLines Fila + 8, "sLen = InStr(1, rString, Chr(0))"
.InsertLines Fila + 9, "If sLen > 0 Then"
.InsertLines Fila + 10, "tString = Left(rString, sLen - 1)"
.InsertLines Fila + 11, "Else"
.InsertLines Fila + 12, "tString = rString"
.InsertLines Fila + 13, "End If"
.InsertLines Fila + 14, "On Error GoTo 0"
.InsertLines Fila + 15, "ReturnUserName = UCase(Trim(tString))"
.InsertLines Fila + 16, "End Function"
End With

With WBModule
Fila = .CountOfLines
.InsertLines Fila + 1, "Private Sub Workbook_BeforePrint(Cancel As
Boolean)"
.InsertLines Fila + 2, "Dim UsuariosRestringidos As Variant"
.InsertLines Fila + 3, "Dim msje As String"
.InsertLines Fila + 4, "Dim NoAutorizado As Integer"
.InsertLines Fila + 5, "UsuariosRestringidos = Array(""Pedro"",
""Pablo"", ""Maria"")"
.InsertLines Fila + 6, "On Error Resume Next"
.InsertLines Fila + 7, "NoAutorizado =
Application.WorksheetFunction.Match _"
.InsertLines Fila + 8, "(ReturnUserName, UsuariosRestringidos, 0)"
.InsertLines Fila + 9, "On Error GoTo 0"
.InsertLines Fila + 10, "If NoAutorizado Then"
.InsertLines Fila + 11, "Cancel = True"
.InsertLines Fila + 12, "msje = ""Impresion restringida."" &
Chr(13)"
.InsertLines Fila + 13, "msje = msje & ""Por favor, contacte
con..."""
.InsertLines Fila + 14, "MsgBox msje"
.InsertLines Fila + 15, "End If"
.InsertLines Fila + 16, "End Sub"
End With
End Sub
'-Fin Codigo


"Pablo" wrote in message
news:

Hola KL, buenas y frias noches desde el norte de Espana.
Con el codigo de abajo estoy creando una copia diaria de algunas hojas de
un
Libro maestro.
Estas copias posteriormente se envian mediante Exchange a nuestra
intranet.

En el momento de creacion de las copias necesitaria insertar o exportar el
codigo de restricciones de impresion.
Es posible hacerlo de modo automatico?





Private Sub CrearLibroRechazos()
Dim wkbOrigen As Workbook, wkbDestino As Workbook
Dim wksH As Worksheet, cHojas As Variant
Dim n As Integer

Set wkbOrigen = ThisWorkbook
Set wkbDestino = Workbooks.Add
cHojas = Array("Rechazos", "CR")
Application.ScreenUpdating = False

'Crear las hojas en el nuevo libro si hay menos de 2 _
o borrar las que excedan de dicho numero.
If wkbDestino.Worksheets.Count < 2 Then
For n = wkbDestino.Worksheets.Count + 1 To 2
wkbDestino.Worksheets.Add
Next n
ElseIf wkbDestino.Worksheets.Count > 2 Then
Application.DisplayAlerts = False
For n = wkbDestino.Worksheets.Count To 3 Step -1
wkbDestino.Worksheets(n).Delete
Next n
Application.DisplayAlerts = True
End If

For n = LBound(cHojas) To UBound(cHojas)
wkbOrigen.Worksheets(cHojas(n)).Cells.Copy
With wkbDestino.Worksheets(n + 1)
' .Range("A1").PasteSpecial xlPasteValues
' .Range("A1").PasteSpecial xlPasteFormats
.Cells.PasteSpecial Paste:=xlValues
.Cells.PasteSpecial Paste:=xlFormats
.Name = wkbOrigen.Worksheets(cHojas(n)).Name
.Activate
.Range("A1").Select
.Protect Password:="Gestores"

End With
Next n

wkbDestino.SaveAs ("C:\Mis Documentos\Rechazos\" & Right("Rechazos" &
Trim(Str(Day(Now() - 1))), 10) _
& (Format(Now() - 1, "mmm") & Right(Str(Year(Now() - 1)), 2))), , ,
("GT"), True


Application.CutCopyMode = False
Application.ScreenUpdating = True

Set wksH = Nothing
Set wkbDestino = Nothing
Set wkbOrigen = Nothing


Agradezco tus respuestas tanto como el calor y la luz de Junio

Gracias de antemano
Pablo
PD. Tu codigo funciona correctamente

"KL" wrote:

Hola Pablo,

Podrias probar hacerlo por codigo, pero, claro, solo funcionara si el
usuario habilita los macros y (incluso con los macros habilitados) no se
le
ocurre usar esta pequna instruccion VBA aunque sea desde la ventana
"Inmediato" del Editor VBA: Application.EnableEvents=False.
En todo caso, prueba el siguiente codigo:

1) Esta parte va a cualquier modulo normal, es decir q no sea de clase,
hoja, libro o formulario

'--Inicio Codigo
Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function ReturnUserName() As String
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen > 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = UCase(Trim(tString))
End Function
'--Fin Codigo

2) Esto va al modulo de EsteLibro (ThisWorkbook):

'--Inicio Codigo
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim UsuariosRestringidos As Variant
Dim msje As String
Dim NoAutorizado As Integer

'Pon aqui los logins reales.
UsuariosRestringidos = Array("Pedro", "Pablo", "Maria")
On Error Resume Next

'Contrastamaos el login de red contra
'la lista de usuarios no autorizados.
'No distingue entre minusc. y mayusc.
NoAutorizado = Application.WorksheetFunction.Match _
(ReturnUserName, UsuariosRestringidos, 0)
On Error GoTo 0
If NoAutorizado Then
Cancel = True
msje = "Impresion restringida." & Chr(13)
msje = msje & "Por favor, contacte con..."
MsgBox msje
End If
End Sub
'--Fin Codigo

Saludos,
KL

Hola KL, de nuevo estoy aquí.
He incluido tu codigo en mi macro y funciona correctamente, tambien es
cierto que si de abre la copia sin ejecutar macros el libro es imprimible y
esto es precisamente lo que pretendo evitar.


De que modo es posible ocultar ó cerrar ó no visualizar el libro copia si no
se ejecutan las macros?

El codigo ó función lo insertaré en mi macro en el momento de crear la
copia ( tal como hize con tu anterior código)


Buen fin de semana
Saludos, Pablo


"KL" wrote:

Pablo,

Como una opcion podrias incrustar el siguienete codigo dentro de tu macro.
Lo malo de este es q es muy aparatoso. Tambien es probable q al copiarlo a
tu modulo tengas q reparar algunas lineas por q habran salido
desconfiguradas. Ojo - si ya existe algun codigo asignado al evento
BeforePrint del libro de destino o existe un nombre de funcion duplicado se
abortara el procedimiento.

Saludos,
KL

'-Inicio Codigo
Option Explicit

Sub CrearModulo()
Dim WBModule As Object
Dim Modulo As Object 'VBComponent
Dim Fila As Integer
Dim x, msje As String, vbc As Object

Application.VBE.MainWindow.Visible = False

'Crea la variable para el modulo ThisWorkBook
Set WBModule =
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule

'Comprueba q no exista una funcion o variable con el mismo nombre
For Each vbc In ActiveWorkbook.VBProject.VBComponents
With vbc.CodeModule
x = .Find("GetUserName", 1, 1, .CountOfLines, 1, False, False)
If x Then
msje = "Ya existe el nombre - GetUserName" & Chr(13)
msje = msje & "No se ha podido anadir codigo!"
MsgBox msje, vbCritical + vbOKOnly, "Error Fatal"
Exit Sub
End If
x = .Find("ReturnUserName", 1, 1, .CountOfLines, 1, False,
False)
If x Then
msje = "Ya existe el nombre - ReturnUserName" & Chr(13)
msje = msje & "No se ha podido anadir codigo!"
MsgBox msje, vbCritical + vbOKOnly, "Error Fatal"
Exit Sub
End If
End With
Next vbc

'Comprueba q no exista procedimientos asignados al evento
With WBModule
x = .Find("Workbook_BeforePrint", 1, 1, .CountOfLines, 1, False,
False)
If x Then
msje = "Ya existe un procedimiento" & Chr(13)
msje = msje & "asignado al evento Workbook_BeforePrint." &
Chr(13)
msje = msje & "No se ha podido anadir codigo!"
MsgBox msje, vbCritical + vbOKOnly, "Error Fatal"
Exit Sub
End If
End With

'Crea Modulo
Set Modulo = ActiveWorkbook.VBProject. _
VBComponents.Add(1)

'Introduce el codigo
With Modulo.CodeModule
Fila = .CountOfLines
.InsertLines Fila + 1, "Public Declare Function GetUserName Lib
""advapi32.dll"" _"
.InsertLines Fila + 2, "Alias ""GetUserNameA"" (ByVal lpBuffer As
String, nSize As Long) As Long"
.InsertLines Fila + 3, "Public Function ReturnUserName() As String"
.InsertLines Fila + 4, "Dim rString As String * 255, sLen As Long,
tString As String"
.InsertLines Fila + 5, "tString = """
.InsertLines Fila + 6, "On Error Resume Next"
.InsertLines Fila + 7, "sLen = GetUserName(rString, 255)"
.InsertLines Fila + 8, "sLen = InStr(1, rString, Chr(0))"
.InsertLines Fila + 9, "If sLen > 0 Then"
.InsertLines Fila + 10, "tString = Left(rString, sLen - 1)"
.InsertLines Fila + 11, "Else"
.InsertLines Fila + 12, "tString = rString"
.InsertLines Fila + 13, "End If"
.InsertLines Fila + 14, "On Error GoTo 0"
.InsertLines Fila + 15, "ReturnUserName = UCase(Trim(tString))"
.InsertLines Fila + 16, "End Function"
End With

With WBModule
Fila = .CountOfLines
.InsertLines Fila + 1, "Private Sub Workbook_BeforePrint(Cancel As
Boolean)"
.InsertLines Fila + 2, "Dim UsuariosRestringidos As Variant"
.InsertLines Fila + 3, "Dim msje As String"
.InsertLines Fila + 4, "Dim NoAutorizado As Integer"
.InsertLines Fila + 5, "UsuariosRestringidos = Array(""Pedro"",
""Pablo"", ""Maria"")"
.InsertLines Fila + 6, "On Error Resume Next"
.InsertLines Fila + 7, "NoAutorizado =
Application.WorksheetFunction.Match _"
.InsertLines Fila + 8, "(ReturnUserName, UsuariosRestringidos, 0)"
.InsertLines Fila + 9, "On Error GoTo 0"
.InsertLines Fila + 10, "If NoAutorizado Then"
.InsertLines Fila + 11, "Cancel = True"
.InsertLines Fila + 12, "msje = ""Impresion restringida."" &
Chr(13)"
.InsertLines Fila + 13, "msje = msje & ""Por favor, contacte
con..."""
.InsertLines Fila + 14, "MsgBox msje"
.InsertLines Fila + 15, "End If"
.InsertLines Fila + 16, "End Sub"
End With
End Sub
'-Fin Codigo