Sv:Problem med att få in bild i word 2003 VBA

Problem med att få in bild i word 2003 VBA

Postades av 2007-08-20 15:14:15 - Mikael Rundberg, i forum microsoft office, Tråden har 9 Kommentarer och lästs av 1614 personer

Jag har en public sub so jag kallar på ifrån andra dokument för att hämta en bild men jag kan inte få den till att fungera ??

Public Sub ShowLogoDocument(bookmarkName As String, typeOfLogo As String, _
Optional logoSize As Single = 2)

Dim currentLogo As String

Select Case typeOfLogo
Case "LITEN"
currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLiten")
Case "STOR"
currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStor")
Case "LITEN_BRED"
currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLitenBred")
Case "STOR_BRED"
currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStorBred")
End Select

ActiveDocument.Bookmarks(bookmarkName).Select
Selection.InlineShapes.AddPicture(fileName:=currentLogo, LinkToFile:=False, _
SaveWithDocument:=True).ShapeRange.Height = CentimetersToPoints(logoSize)

End Sub

Felet ligger någonstans i de tre sista raderna. Det den skall göra är lägga in en bild enligt bookmarken vilken enligt typoflogo o sen storlek enligt logoSize.

Svara

Sv: Problem med att få in bild i word 2003 VBA

Postades av 2007-08-21 14:48:38 - Åsa Holmgren

Mängden ShapeRange innehåller inte InlineShapes, därför får du fel. Detta funkar:

Selection.InlineShapes.AddPicture(FileName:=currentLogo, LinkToFile:=False, _
    SaveWithDocument:=True).Height = CentimetersToPoints(2)

Med den koden kommer du dock att få problem om du vill att bilden ska behålla samma proportioner.

Jag föreslår något i den här stilen:

Public Sub ShowLogoDocument(bookmarkName As String, typeOfLogo As String, _
    Optional logoSize As Single = 2)

    Dim ishp As InlineShape
    Dim currentLogo As String

    On Error Goto ShowLogoDocument_Err

    Select Case typeOfLogo
        Case "LITEN"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLiten")
        Case "STOR"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStor")
        Case "LITEN_BRED"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLitenBred")
        Case "STOR_BRED"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStorBred")
    End Select

    With ActiveDocument  
        Set ishp = .InlineShapes.AddPicture(FileName:=sPath, LinkToFile:=False, _
            SaveWithDocument:=True, Range:=.Bookmarks(bookmarkName).Range)
    End With

    With ishp
        fRatio = 100 * CentimetersToPoints(2) / .Width
        .ScaleWidth = fRatio
        .ScaleHeight = fRatio
    End With

ShowLogoDocument_End:
    Set ishp = Nothing
    Exit Sub

ShowLogoDocument_Err:
    Msgbox "Det gick åt skogen!"
    Goto ShowLogoDocument_End:
End Sub

Svara

Sv: Problem med att få in bild i word 2003 VBA

Postades av 2007-08-22 12:50:36 - Mikael Rundberg

Okej skall prova lite med den........ Tackar

Svara

Sv:Problem med att få in bild i word 2003 VBA

Postades av 2007-08-22 14:50:45 - Mikael Rundberg

Okej nu gjorde lite små ändringar o fixade formlen så jag kan justera storleken

Public Sub ShowLogoDocument(bookmarkName As String, typeOfLogo As String, Optional logoSize As Single = 2)

    Dim ishp As InlineShape
    Dim currentLogo As String
    Dim fRatio As Variant

    On Error GoTo ShowLogoDocument_Err

    Select Case typeOfLogo
        Case "LITEN"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLiten")
        Case "STOR"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStor")
        Case "LITEN_BRED"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLitenBred")
        Case "STOR_BRED"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStorBred")
    End Select

    With ActiveDocument
        Set ishp = .InlineShapes.AddPicture(fileName:=currentLogo, LinkToFile:=False, _
            SaveWithDocument:=True, Range:=.Bookmarks(bookmarkName).Range)
    End With

    With ishp
        fRatio = (CentimetersToPoints(logoSize) / ishp.Height) * 100 ' ny formel
        .ScaleWidth = fRatio
        .ScaleHeight = fRatio
    End With

ShowLogoDocument_End:
    Set ishp = Nothing
    Exit Sub

ShowLogoDocument_Err:
    MsgBox "Det gick åt skogen!"
    GoTo ShowLogoDocument_End:
End Sub

Som du ser satte jag in en ny formel för att justera storleken på bilden, men om jag skickar in i variablen att den skall var 1cm hög så blir den 1,85cm ??
Här någonstans har jag fått en tanke vurpa. Hur kan jag få den att bli så stor som jag säger med logoSize

Svara

Sv: Problem med att få in bild i word 2003 VBA

Postades av 2007-08-22 16:39:27 - Åsa Holmgren

Mysko! hos mig funkar din kod bra... 1 cm blir 1 cm.

Svara

Sv:Problem med att få in bild i word 2003 VBA

Postades av 2007-08-23 07:58:37 - Mikael Rundberg

Det verkar som när bilden läggs in så automat skalar ner bilden till 54% för att få plats på bladet, formlen beräknar på den nya storleken och säger att bilden skall vara 42% stor av den nya storleken. Men när man sätter in den nya skalningen så är det gällande för orginal storleken (4,39cm hög) så skalningen borde igenteligen var på 23% för att man skall få den 1cm stor. Hur hittar man bildens orginalstorlek. eller finns det något annat sätt o göra det på. Jag har en annan kod snutt som fungerar för sidhuvud o sidfot men kan inte omvandla den till att fungera i huvuddokumentet.

Public Sub ShowLogoHeader(bookmarkName As String, typeOfLogo As String, Optional logoSize As Single = 2)
  Dim currentLogo As String
  ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  
  Select Case typeOfLogo
  Case "LITEN"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLiten")
  Case "STOR"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStor")
  Case "LITEN_BRED"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLitenBred")
  Case "STOR_BRED"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStorBred")
  End Select
  
  Dim pic As Shape
  Set pic = ActiveWindow.ActivePane.Selection.HeaderFooter.Shapes.AddPicture(currentLogo, True)
  pic.Height = CentimetersToPoints(logoSize)
 SaveWithDocument:=True
  
  'Stänger sidhuvudet
  ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

Svara

Sv: Problem med att få in bild i word 2003 VBA

Postades av 2007-08-23 10:34:17 - Åsa Holmgren

Ok, den första automatskalningen förklarar ju saken.

Anledningen till att din kod för logotype i sidhuvudet fungerar bättre är att där har du en bild vars layout är framför eller bakom text, medan logotypen i dokumentet är i nivå med text. Bilder i nivå med text är InlineShape-objekt, alla andra bilder är Shape-objekt. Båda objekttyperna har en egenskap som heter "LockAspectRatio" som anger att proportionerna ska behållas, men för InlineShape's funkar den inte :(

Testa det här sättet att ändra storleken:

With ishp
    .Height = CentimetersToPoints(logoSize)
    .ScaleWidth = .ScaleHeight
End With

Svara

Sv:Problem med att få in bild i word 2003 VBA

Postades av 2007-08-24 07:54:12 - Mikael Rundberg

Det verkar som bilden skalas automatiskt när den läggs in på dokumentet. Jag gjorde om koden för att kompensera för detta men det blir inte riktigt hundra.

Public Sub ShowLogoDocument(bookmarkName As String, typeOfLogo As String, Optional logoSize As Single = 2)

    Dim ishp As InlineShape
    Dim currentLogo As String
    Dim fRatio As Variant
    Dim tempfRatio As Variant

    On Error GoTo ShowLogoDocument_Err

    Select Case typeOfLogo
        Case "LITEN"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLiten")
        Case "STOR"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStor")
        Case "LITEN_BRED"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLitenBred")
        Case "STOR_BRED"
            currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStorBred")
    End Select

    With ActiveDocument
        Set ishp = .InlineShapes.AddPicture(fileName:=currentLogo, LinkToFile:=False, _
            SaveWithDocument:=True, Range:=.Bookmarks(bookmarkName).Range)
    End With

    With ishp
        tempfRatio = .ScaleHeight
        fRatio = ((CentimetersToPoints(logoSize) / ishp.Height) * 100)
        fRatio = ((tempfRatio / fRatio) - 1) * 100
        .ScaleWidth = fRatio
        .ScaleHeight = fRatio
    End With

ShowLogoDocument_End:
    Set ishp = Nothing
    Exit Sub

ShowLogoDocument_Err:
    MsgBox "Det gick åt skogen!"
    GoTo ShowLogoDocument_End:
End Sub

Som du ser har jag lagt in en justering på koden för att kunna fixa med original storleken. Men det blir en fel marginal eftersom % som det visas in in har med alla decimalerna

        tempfRatio = .ScaleHeight
        fRatio = ((CentimetersToPoints(logoSize) / ishp.Height) * 100)
        fRatio = ((tempfRatio / fRatio) - 1) * 100

jag skulle vilja ha orginal höjden i points som är mer precise.

Svara

Sv: Problem med att få in bild i word 2003 VBA

Postades av 2007-08-24 09:48:35 - Åsa Holmgren

Jag tror att du krånglar till det, har du provat mitt senaste förslag?

Svara

Sv:Problem med att få in bild i word 2003 VBA

Postades av 2007-08-24 11:49:23 - Mikael Rundberg

Jag gjorde det men det gick inte riktig som tänkt, så jag bytte tanke bana lite o gjorde så här istället o det fungerar perfekt

Public Sub ShowLogo(bookmarkName As String, typeOfLogo As String, Optional logoSize As Single = 2)
  Dim currentLogo As String
  
  Select Case typeOfLogo
  Case "LITEN"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLiten")
  Case "STOR"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStor")
  Case "LITEN_BRED"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoLitenBred")
  Case "STOR_BRED"
    currentLogo = IVGetPrivateProfileString("IVTmp", "USER", "LogoStorBred")
  End Select

  Dim pic As InlineShape
  ActiveDocument.Bookmarks(bookmarkName).Select
  Set pic = Selection.InlineShapes.AddPicture(currentLogo, True, True, ActiveDocument.Bookmarks(bookmarkName).Range)
  Dim pictHeight As Double
  pictHeight = CentimetersToPoints(logoSize)
  pic.Width = pictHeight * pic.Width / pic.Height
  pic.Height = pictHeight
End Sub

Tack så mycket för hjälpen

Svara

Problem med att få in bild i word 2003 VBA

Sv: Problem med att få in bild i word 2003 VBA

Sv: Problem med att få in bild i word 2003 VBA

Sv:Problem med att få in bild i word 2003 VBA

Sv: Problem med att få in bild i word 2003 VBA

Sv:Problem med att få in bild i word 2003 VBA

Sv: Problem med att få in bild i word 2003 VBA

Sv:Problem med att få in bild i word 2003 VBA

Sv: Problem med att få in bild i word 2003 VBA

Sv:Problem med att få in bild i word 2003 VBA

Nyligen

Sidor

Statistik

Kontakta oss