Toon posts:

Foto automatisch aanpassen naar de celgrootte in Excel

Pagina: 1
Acties:

Onderwerpen

Vraag


Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
Ik gebruik een Excel lijst waar zowel info als foto's worden ingezet.
Ik heb een macro gevonden op het internet (kant en klaar) die nu gebruikt wordt om de foto's automatisch aan te passen naar de celgrootte.

Nu heb ik 1 probleem en zou ik ook nog 1 extra functie willen toevoegen.

Even stap voor stap:
1) Het probleem:
Als de foto via de macro wordt verkleint, je slaat het file op (save) en je sluit af.
Als je nadien het file terug opent en je wil de foto terug vergroten (handmatig uitrekken) om details te bekijken, is de foto mee gecomprimeerd en dat is eigenlijk niet de bedoeling.
Het is de bedoeling dat deze scherp blijft en nu wordt ze heel wazig als je ze terug uitvergroot.
Vermoedelijk zit dit mee in de code.

2)Extra functie toevoegen:
Ik zou ook graag een extra functie aan deze macro toevoegen, als de macro gebruikt wordt om de foto te verkleinen, hij deze ook automatisch gaat centreren in de cel zelf (ongeacht de foto horizontaal of verticaal getrokken is).
Als de macro nu gebruikt wordt, staat een horizontale foto bovenaan de cel en moeten we ze zelf centreren, bij een verticale foto wordt de foto altijd links in de cel gezet en moeten we ze ook manueel centreren.


Iemand een idee om de code aan te passen?

Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Public Sub FitPic()
On Error GoTo NOT_SHAPE
Dim PicWtoHRatio As Single
Dim CellWtoHRatio As Single
With Selection
PicWtoHRatio = .Width / .Height
End With
With Selection.TopLeftCell
CellWtoHRatio = .Width / .RowHeight
End With
Select Case PicWtoHRatio / CellWtoHRatio
Case Is > 1
With Selection
.Width = .TopLeftCell.Width
.Height = .Width / PicWtoHRatio
End With
Case Else
With Selection
.Height = .TopLeftCell.RowHeight
.Width = .Height * PicWtoHRatio
End With
End Select
With Selection
.Top = .TopLeftCell.Top
.Left = .TopLeftCell.Left
End With
Exit Sub
NOT_SHAPE:
MsgBox "Select a picture before running this macro."
End Sub

Alle reacties


Acties:
  • 0 Henk 'm!

  • g0tanks
  • Registratie: Oktober 2008
  • Laatst online: 01:36

g0tanks

Moderator CSA
Het is natuurlijk niet de bedoeling dat wij je programmeervraagstukken gaan oplossen zonder dat je eerst zelf iets probeert. Heb je een idee van waar het in de code zou moeten zitten? Of hoe de code eruit moet zien voor de nieuwe functie?

Ultrawide gaming setup: AMD Ryzen 7 2700X | NVIDIA GeForce RTX 2080 | Dell Alienware AW3418DW


Acties:
  • 0 Henk 'm!

  • MAX3400
  • Registratie: Mei 2003
  • Laatst online: 27-09 22:07

MAX3400

XBL: OctagonQontrol

@Verwijderd aangezien je de code niet zelf geschreven hebt (ik vond namelijk de exacte code op minstens 3 andere sites), vraag ik me af of functie voor centreren ook niet elders al beschreven is? Ik ben geen programmeur maar allicht had je https://www.mrexcel.com/b...l-size-vba-macro.1082446/ al gevonden en misschien iets mee kunnen doen?

Voor je issue 1 is het wel erg duidelijk dat dit niet in de code zit; ik zie in ieder geval nergens dat er een vermindering van het aantal pixels moet plaatsvinden. Iets zegt me dat dit dus "standaard" gedrag is van Excel maar dat zal ongetwijfeld ergens onder de F1-toets te vinden zijn? Sowieso zegt Microsoft dat 220ppi de standaard is maar dat je (door bepaalde bewerkingen, handmatig of via macro's) inderdaad aan je ppi en dus je "zichtbare" pixels sleutelt.

Mijn advertenties!!! | Mijn antwoorden zijn vaak niet snowflake-proof


Acties:
  • 0 Henk 'm!

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

g0tanks schreef op donderdag 26 maart 2020 @ 16:31:
Het is natuurlijk niet de bedoeling dat wij je programmeervraagstukken gaan oplossen zonder dat je eerst zelf iets probeert. Heb je een idee van waar het in de code zou moeten zitten? Of hoe de code eruit moet zien voor de nieuwe functie?
^^^ dat ja. We denken graag mee maar kant-en-klare code kan je krijgen door iemand in te huren ;)

De code die je toont is overigens volgend mij heel redelijk als leek te lezen. Tenminste, ik denk dat iets als Width = .TopLeftCell.Width redelijk is te lezen: de breedte wordt de breedte van de cel linksbovenaan. De code laat niets zien over compressie dus dat gebeurt daar niet.

Dat is een functie van Excel zelf die je in de opties kunt uitschakelen - en dat dan moet doen op elke machine waar je het bestand gebruikt.

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
@MAX3400 ik heb al eens geïnformeerd bij een IT'er die ik ken en hij wist mij te zeggen dat het in de code zit …
Ik vind het wel vreemd als ik de foto's handmatig verklein naar de cel dit probleem niet opduikt en als ik ze verklein aan de hand van de macro, dat ze dan wel wazig zijn bij het terug vergroten …
Ik ga het eens uitzoeken met de Excel help functie dan.

@g0tanks ik vermoed ergens lijn 24 & 25 aanpassen naar center?

Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
Wat betreft het centreren, @g0tanks kan deze code werken voor het centreren van de foto?

Visual Basic:
1
2
3
4
5
6
7
8
Sub CenterMe(Shp As Shape, OverCells As Range)


With OverCells
Shp.Left = .Left + ((.Width - Shp.Width) / 2)
Shp.Top = .Top + ((.Height - Shp.Height) / 2)
End With
End Sub


Speelt het een grote rol waar je zo'n code tussen zet of mag dat helemaal onderaan de toegevoegd worden?

Acties:
  • 0 Henk 'm!

Verwijderd

Topicstarter
Ik heb het probleem van het comprimeren gevonden in Excel.
Dit is nu ingesteld om niet meer te comprimeren en de kwaliteit heb ik ingesteld op het hoogste.

Wat betreft het centreren heb ik ook nog deze code gevonden:
Visual Basic:
1
2
3
4
5
6
7
8
9
10
Sub CenterObjectInActiveCell()
    Dim X As Integer
    Dim Y As Integer
    X = ActiveCell.Left + (ActiveCell.Width / 2) - (ActiveSheet.Shapes(1).Width / 2)
    Y = ActiveCell.Top + (ActiveCell.Height / 2) - (ActiveSheet.Shapes(1).Height / 2)
    With ActiveSheet.Shapes(1)
        .Left = X
        .Top = Y
    End With
End Sub


kan dat daar ergens tussen gezet worden of mag dat onderaan?
Pagina: 1