Makro og VBA - Indsætning af billede......

Print side | Luk vindue

Indsætning af billede......

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=279
Udskrevet den: 16.Maj.2024 kl. 16:44

Emne: Indsætning af billede......

Besked fra: kbno
Emne: Indsætning af billede......
Posteringsdato: 10.Mar.2011 kl. 09:08

Vi har på arbejde udarbejdet et nyt skema i forbindelse med energibesparelse og i den forbindelse vil vi godt have et billede ind i skemaet af den enkelte bygning. Men da ikke alle kan finde ud af Excel på meget mere end brugerniveau (læs - indtaste data) havde jeg en ide om at indlægge en knap man bare trykkede på og så kom den alm. vindue frem hvor man bare skal markerer og hvilken file man skal bruge, og så skulle den self ligge i den forudbestemte celle med en forudbestemt størrelse (bredde*højde)

Er dette helt ude i hampen ???? Eller ligger den til venstre benet

-------------
Hygge - Kim
Excel 365 DK user

Svar:

Besked fra: Allan
Posteringsdato: 10.Mar.2011 kl. 10:05

Hej Kim,

Højrebenet vil jeg mene

Hvis du bruger denne kodestump i et modul, vil Excel egen 'Indsæt billede' dialog komme til syne.

Application.Dialogs(xlDialogInsertPicture).Show

//Allan

Besked fra: kbno
Posteringsdato: 10.Mar.2011 kl. 10:36

SUPER - vidste i havde det i Jer

men nu bliver jeg lidt krævende - kan man bestemme HVOR den skal indsætte billedet - for lige nu smider den det bare i venstre hjørne.

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 10.Mar.2011 kl. 10:51

Jo, hvis dine billeder er nogenlunde ens i størrelsen, kan du bare aktivere den celle som billedet skal være i.

Range("A10").select

Application.Dialogs(xlDialogInsertPicture).Show

Billedet bliver sat ind i A10

Vil du også kontrollere størrelsen?

//Allan

Besked fra: kbno
Posteringsdato: 10.Mar.2011 kl. 14:26

Ja hvis det var muligt

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 10.Mar.2011 kl. 15:27

OK, så må vi give den lidt ekstra gas

Som standard placerer denne kode billedet i A10, men det kan du ændre.

Højde og bredde er som standard 100 pixels, det kan du også ændre.

Dejlig kode

Private Const Hoejde = "100" 'Hvis højde skal tilpasses cellens højde, ændres den til ""
Private Const Bredde = "100" 'Hvis bredde skal tilpasses celles højde, ændres den til ""
Private Const Placering = "A10" 'Hvis billedes skal være i aktive celle, ændres den til ""

Sub Indsaet_Billede()

Application.ScreenUpdating = False

ActCell = ActiveCell.Address

If Placering <> "" Then Range(Placering).Select

Set Billede = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Alle filer,*.*"))
With Billede
    .ShapeRange.LockAspectRatio = msoFalse
        If Hoejde = "" Then
                .Height = ActiveCell.Height
            Else
                .Height = Hoejde
            End If
        If Bredde = "" Then
                .Width = ActiveCell.Width
            Else
                .Width = Bredde
            End If
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    .Placement = xlMoveAndSize
End With

Set Billede = Nothing
Range(ActCell).Select
Application.ScreenUpdating = True
End Sub

//Allan

Besked fra: kbno
Posteringsdato: 11.Mar.2011 kl. 10:02

hmm den giver fejl - kan det have noget at gøre med at jeg kører en US version ???

Private Sub CommandButton1_Click()

Private Const Hoejde = "" 'Hvis højde skal tilpasses cellen, ændres det til ""
Private Const Bredde = "100" 'Hvis bredde skal tilpasses cellen, ændres det til ""
Private Const Placering = "g3" 'Hvis aktivecelle ønskes, ændres det til ""
Sub Indsaet_Billede()
Application.ScreenUpdating = False
ActCell = ActiveCell.Address
If Placering <> "" Then Range(Placering).Select
Set Billede = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Alle filer,*.*"))
With Billede
    .ShapeRange.LockAspectRatio = msoFalse
        If Hoejde = "" Then
                .Height = ActiveCell.Height
            Else
                .Height = Hoejde
            End If
        If Bredde = "" Then
                .Width = ActiveCell.Width
            Else
                .Width = Bredde
            End If
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    .Placement = xlMoveAndSize
End With
Set Billede = Nothing
Range(ActCell).Select
Application.ScreenUpdating = True

End Sub

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 11.Mar.2011 kl. 10:49

Hej igen,

Nej, det er koden som er sat forkert ind.

Brug denne i stedet.

Private Const xxxxx skal ALTID være i toppen af modulet, ellers vil koden fejle.

Du havde sat min kode ind i en anden kode, således at der var 2 sub'er og 2 kodenavne i samme kode, den går ikke

Private Const Hoejde = "" 'Hvis højde skal tilpasses cellens højde, ændres den til ""
Private Const Bredde = "100" 'Hvis bredde skal tilpasses celles højde, ændres den til ""
Private Const Placering = "G3" 'Hvis billedes skal være i aktive celle, ændres den til ""

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ActCell = ActiveCell.Address
If Placering <> "" Then Range(Placering).Select
Set Billede = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Alle filer,*.*"))
With Billede
    .ShapeRange.LockAspectRatio = msoFalse
        If Hoejde = "" Then
                .Height = ActiveCell.Height
            Else
                .Height = Hoejde
            End If
        If Bredde = "" Then
                .Width = ActiveCell.Width
            Else
                .Width = Bredde
            End If
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    .Placement = xlMoveAndSize
End With
Set Billede = Nothing
Range(ActCell).Select
Application.ScreenUpdating = True

End Sub

//Allan

Besked fra: kbno
Posteringsdato: 11.Mar.2011 kl. 11:48

Ja så virker det - sådan da. Da cellen billedet skal sættes ind i er lavet ved at formaterer 6 kolonner og x antal rækker fylder den kun billedet ind i det der svarer til den første kolonne. Jeg kan godt få det til at virke hvis jeg taster BÅDE højde og bredde ind (340*745). Det gør måske ikke så meget - den strækker jo bare billedet. Men hvis man nu kunne få det til at funke ved en lille justering ville det være guld

BTW - fik jeg lige sagt at jeg synes i er nogel guder herinde

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 11.Mar.2011 kl. 12:49

Tak for de rosende ord Kim

, jeg er glad for at forummet er blevet den succes det er. Det er fedt at kunne hjælpe så mange mennesker med deres udfordringer (i regnearksmæssig forstand

)

En lille rettelse af koden gør det muligt.

Prøv den lige af.

Private Const Hoejde = "" 'Hvis højde skal tilpasses cellens højde, ændres den til ""
Private Const Bredde = "" 'Hvis bredde skal tilpasses celles højde, ændres den til ""
Private Const Placering = "G3" 'Hvis billedes skal være i aktive celle, ændres den til ""

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ActCell = ActiveCell.Address
If Placering <> "" Then Range(Placering).Select
Set Billede = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Alle filer,*.*"))
With Billede
    .ShapeRange.LockAspectRatio = msoFalse
        If Hoejde = "" Then
                .Height = Selection.Height
            Else
                .Height = Hoejde
            End If
        If Bredde = "" Then
                .Width = Selection.Width
            Else
                .Width = Bredde
            End If
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    .Placement = xlMoveAndSize
End With
Set Billede = Nothing
Range(ActCell).Select
Application.ScreenUpdating = True

End Sub

//Allan

Besked fra: kbno
Posteringsdato: 11.Mar.2011 kl. 13:15

Jeps - så strækker den i begge retninger - men kan man få den til kun at tilpasse højden og så ignorerer bredden, men stadigvæk beholde image ratio ???

Jeg har forsøgt at ændre lidt i koden:

Private Const Hoejde = "" 'Hvis højde skal tilpasses cellens højde, ændres den til ""
Private Const Placering = "G3" 'Hvis billedes skal være i aktive celle, ændres den til ""
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ActCell = ActiveCell.Address
If Placering <> "" Then Range(Placering).Select
Set Billede = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Alle filer,*.*"))
With Billede
    .ShapeRange.LockAspectRatio = msoFalse
        If Hoejde = "" Then
                .Height = Selection.Height
            Else
                .Height = Hoejde
            End If
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    .Placement = xlMoveAndSize
End With
Set Billede = Nothing
Range(ActCell).Select
Application.ScreenUpdating = True
End Sub

og det ser ud til at virke til dels, dvs. den holder ikke image ratio hvis billedet er mindre end cellehøjden. Dog er der ingen problemer hvis billedet er højer end cellehøjden.

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: kbno
Posteringsdato: 11.Mar.2011 kl. 13:22

Har også lige opdaget at hvis man trykker på knappen, men så annullerer det insert image vinduet så laver den en fejl.

Runtime Error '1004'

Unable to get the Insert Proberty of the picture class

Dette med både din kode og min kode.

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 11.Mar.2011 kl. 13:28

Image ratio kan du godt komme udenom.

.ShapeRange.LockAspectRatio = msoFalse

Skal udskiftes med

.ShapeRange.LockAspectRatio = msoTrue

//Allan

Besked fra: kbno
Posteringsdato: 11.Mar.2011 kl. 13:38

Allan skrev:

Image ratio kan du godt komme udenom.

.ShapeRange.LockAspectRatio = msoFalse

Skal udskiftes med

.ShapeRange.LockAspectRatio = msoTrue

//Allan

Det havde jeg prøvet, men ak den vrider stadig - se billeder

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: kbno
Posteringsdato: 11.Mar.2011 kl. 13:50

Kan det evt. have noget at gøre med at det er 2003 versionen af Excell ???

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 11.Mar.2011 kl. 14:16

Jeg kan godt se det, denne kode skalerer som den skal og virker i 2007

Jeg synes ikke jeg kan finde nogle steder som skriver at der skulle være forskel på versionerne mht. dette.

Private Const Hoejde = "" 'Hvis højde skal tilpasses cellens højde, ændres den til ""
Private Const Placering = "G3" 'Hvis billedes skal være i aktive celle, ændres den til ""
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ActCell = ActiveCell.Address
If Placering <> "" Then Range(Placering).Select
Set Billede = ActiveSheet.Pictures.Insert(Application.GetOpenFilename("Alle filer,*.*"))
With Billede
    .ShapeRange.LockAspectRatio = msoTrue
        If Hoejde = "" Then
                .Height = Selection.Height
            Else
                .Height = Hoejde
            End If
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    .Placement = xlMoveAndSize
End With
Set Billede = Nothing
Range(ActCell).Select
Application.ScreenUpdating = True
End Sub

Besked fra: kbno
Posteringsdato: 11.Mar.2011 kl. 16:33

Det virker også i min Excel 2010 versio, så det er åbentbart 2003 versionen som driller.

Så 1000000000000000000000 gange tak for hjælpen Clap

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 11.Mar.2011 kl. 19:15

Det var da dejligt det virkede i Excel 2010.

Hvorfor det ikke virker i 2003 må stå hen i det uvisse, jeg har nemlig ikke 2003 på min computer mere.

God aften.

//Allan

Besked fra: Allan
Posteringsdato: 15.Feb.2012 kl. 11:15

Som en lille tillægsinformation, findes denne funktion nu i BST Utilities.

https://www.bst-utilities.dk/?pageIDX=216" >https://www.bst-utilities.dk/?pageIDX=216

//Allan

-------------
MVH

Allan
https://www.excel-regneark.dk" rel="nofollow - Excel-regneark.dk - Gratis skabeloner til Excel
Få over 120 ekstra funktioner med Danmarks bedste add-in

Print side | Luk vindue