Problemer med excel, ved oprettelse af pdf.

Hej,

Jeg har lavet en vba-programmering, som laver et pdf-dokument ud fra excel... og det har i meget lang tid fungeret upåklageligt, selvom det måske ikke ser direkte kønt ud ;)

Nu har jeg fået ny computer - og så kommer der et problem: Mit indsatte tif-billede, som er hentet fra internettet, ser aldeles forkert ud!

Er det en indstilling i Excel - eller muligvis i adobe, der gør, at farverne er helt forkerte?

Baggrundsbilledet er faktisk helt sort!!!

Koden er således:

---

Sub gembestil()
    Dim Filnavnet As String
    Filnavnet = MyName()
    Sheets("Datablad").Select
   
    Dim wkbCopy As Workbook
    Dim wksTemp As Worksheet
    Dim lTemp As Long
    Dim bytAns As Long
   
   
        Dim myPath As String
            myPath = ActiveWorkbook.Path
   

    Worksheets(Array("Datablad")).Copy
    Set wkbCopy = ActiveWorkbook
   
      For Each wksTemp In wkbCopy.Worksheets
        lTemp = wksTemp.UsedRange.rows.Count
        wksTemp.UsedRange.Value = wksTemp.UsedRange.Value
    Next wksTemp

    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
        .DisplayHorizontalScrollBar = False
        .DisplayWorkbookTabs = False
    End With
        Columns("ab").Delete
       
  Application.Run "sletlinier"
 

    Range("A1").Select
    ActiveSheet.PageSetup.LeftHeaderPicture.Filename = _
        "http://www.dbhome.dk/tjep/GP/Billeder/AKASISON (A4)2.tif"
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = "&G"
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .FitToPagesWide = 1
        .FitToPagesTall = 4
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(1.15)
        .BottomMargin = Application.InchesToPoints(1.5)
        .HeaderMargin = Application.InchesToPoints(0.1)
        .FooterMargin = Application.InchesToPoints(0.1)
        .PrintHeadings = False
        .PrintGridlines = False
'        .PrintComments = xlPrintNoComments
'        .PrintQuality = -3
'        .CenterHorizontally = False
'        .CenterVertically = False
'        .Orientation = xlPortrait
'        .Draft = False
        .PaperSize = xlPaperA4
'        .FirstPageNumber = xlAutomatic
'        .Order = xlDownThenOver
'        .BlackAndWhite = False
        .Zoom = 100
'        .PrintErrors = xlPrintErrorsDisplayed
'        .OddAndEvenPagesHeaderFooter = False
'        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
'        .EvenPage.LeftHeader.Text = ""
'        .EvenPage.CenterHeader.Text = ""
'        .EvenPage.RightHeader.Text = ""
'        .EvenPage.LeftFooter.Text = ""
'        .EvenPage.CenterFooter.Text = ""
'        .EvenPage.RightFooter.Text = ""
'        .FirstPage.LeftHeader.Text = ""
'        .FirstPage.CenterHeader.Text = ""
'        .FirstPage.RightHeader.Text = ""
'        .FirstPage.LeftFooter.Text = ""
'        .FirstPage.CenterFooter.Text = ""
'        .FirstPage.RightFooter.Text = ""

    End With
'    Application.PrintCommunication = True



Range("B2").Select

    ActiveWindow.SmallScroll Down:=-30
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

    Dim fnavn As String
    Dim strPath As String
    Dim strFileName As String

If Len(Dir(myPath & "\Datablade\", vbDirectory)) = 0 Then
    MkDir myPath & "\Datablade\"
End If
strPath = myPath & "\Datablade\"



Windows(Filnavnet).Activate
If Worksheets("Indtast").CheckBox1.Value = True Then


        ChDir (strPath)
       
        wkbCopy.ExportAsFixedFormat Type:=xlTypePDF, Filename:="" & Range("Datablad!a1").Text _
        & " - (" & Range("Datablad!f3") & ".xxx).pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
       
        wkbCopy.Close savechanges:=False
        Set wksTemp = Nothing
        Set wkscopy = Nothing
   
   
Else
 
    Application.DisplayAlerts = False

   
    wkbCopy.SaveAs Filename:=strPath & "" & Range("Datablad!a1").Text _
    & " - (" & Range("Datablad!f3") & ".xxx).xls" ' Change filepath and name

    wkbCopy.Close
   
    Application.DisplayAlerts = True

    Set wksTemp = Nothing
    Set wkscopy = Nothing
     
End If
End Sub