Application.PrintCommunication, ERROR CON MISTERIO ;-)

Buenas a todos.

Tengo este codigo que forma parte de una macro, que como podeis ver sirve para crear y enviar PDF por email pero esta es la seccion donde en ocasiones me produce el error. En condiciones normales y fuera de la oficina con conexion normal a Internet funciona de maravilla.

El problema viene cuando tengo el ordenador en la oficina y está conectado a la red de la empresa y al usar la macro se me para en esta linea Application.PrintCommunication = False.

Me tiene descolocado ya que tengo configurado como impresora predeterminada CUTE PDF y no se porque en la ofi se para siempre aquí y fuera de la ofi funciona.

En la oficina hay impresoras en red a las que estoy conectado pero de manera automática. ¿¿Hay alguna forma de cambiar la orden para que tenga la impresora que tenga conectada siempre elija o CUTE PDF o Adobe Reader??.

Gracias de antemano a todos por vuestro tiempo.

Un saludo.

Range("B2").Select[COLOR=#ff0000][B]    Application.PrintCommunication = False[/B][/COLOR]

    With ActiveSheet.PageSetup

        .PrintTitleRows = "$1:$2"

        .PrintTitleColumns = ""

    End With

Range("a2:U10").Select

CREAR_PDF = ThisWorkbook.Path & "\" & "PEDIDOS2013.pdf"

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CREAR_PDF, _

Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _

:=False, OpenAfterPublish:=False



Worksheets(6).Select

Ruta = "c:\Temp\"

fichero = Ruta & "PEDIDOS2013.pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichero, _

    Quality:=xlQualityStandard, _

    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True


Dim objOutlook As Object

Dim obItem As Object

Dim obkNamespace As Object

Dim ADJUNTO As Variant

Set objOutlook = CreateObject("Outlook.Application")

Set ObjNamespace = objOutlook.getnamespace("MAPI")

Set ObjItem = objOutlook.Createitem(olMailItemn)

ObjNamespace.logon "EXCELSPACE", , True, True

ADJUNTO = fichero

With ObjItem

    .Attachments.Add (ADJUNTO)

    .Display

    .To = ""

    .CC = ""

    .BCC = ""

    .Subject = "NUEVOS PEDIDOS 2013"

    .Body = "Muy Buenas. Adjunto PEDIDOS NUEVOS 2013. Consúltame si tienes alguna duda. Un saludo"

    .Display

End With

ObjNamespace.Logoff

Set objOutlook = Nothing

Set ObjItem = Nothing

Set ObjNamespace = Nothing

With Application

 .ScreenUpdating = True

 .Calculation = xlCalculationAutomatic

End With

Shell ("cmd /c, Taskkill /f /IM AcroRd32.exe"), vbMaximizedFocus[/CODE]