Informatie genereren, plakken als afbeelding

Status
Niet open voor verdere reacties.
B

Bergsma1

Gebruiker
Lid geworden
7 feb 2012
Berichten
40
Ik loop tegen het volgende probleem aan

Ik heb een sheet met een groot aantal tabbladen.

Vanuit deze gegevens wordt op Tabblad A een formulier gegenereerd door ingeving van een formuliercode in Range("I8")
-Het formulier bevindt zich in bereik ("A1:G30")

Tabblad B, bevat in Range("A1:ZZ1") formuliercodes waarmee ik alle formulieren wil genereren.
In de range daaronder ("A2:ZZ2") wil ik al deze formulieren als afbeelding plakken.
in de volgende ratio's.

Selection.ShapeRange.ScaleWidth 0.4, msoFalse, msoScaleFromMiddle
Selection.ShapeRange.ScaleHeight 0.4, msoFalse, msoScaleFromMiddle

Zouden jullie mij verder kunnen helpen?

In verband met vertrouwelijkheid kan ik helaas geen bestand delen.
 
Voorbeeldbestand

Zie voorbeeldbestand
 

Bijlagen

  • Voorbeeld.xlsx
    40,4 KB · Weergaven: 27
Code: 
Sub Bergsma1()
   Sheets("a").Range("A1:G30").Copy              'je te kopieren bereik
   Set b = Sheets("B")
   With b
      Set c = .Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)   'lege cel bepalen
      Application.Goto c, 0                      'er naar toe gaan
      i = .Shapes.Count                          'aantal shapes
      .Pictures.Paste.Select                     'zaakje plakken als afbeelding
      Set pict = Selection.ShapeRange
      With pict
         .ScaleHeight 0.4, msoFalse, msoScaleFromMiddle   'opschalen hoogte
         .ScaleWidth 0.4, msoFalse, msoScaleFromMiddle   'opschalen breedte
         b.Shapes(i + 1).Cut                     'knippen
         b.Paste                                 'plakken in de goeie cel
         c.Value = Time                          'iets in die cel zetten zodat je de volgende keer de cel er naast gebruikt
         c.EntireColumn.ColumnWidth = 15         'kolombreedte aanpassen
      End With
   End With
   Application.Goto c.Offset(, 1), 0             'naar de cel ernaast stappen
End Sub
 
Bedankt voor het meedenken! Zonet even getest, en ik zie een kopieer en plakslag, Ik zoek toch een andere werking.
Ik wil graag dat alle waarden die op Tabblad B, range("A1:AZ1") staan worden ingevoerd op Tabblad A, Range("I8").
Dat genereert een afbeeldingen op Tabblad A, Range("A1:G30")
Deze afbeeldingen wil ik dan graag allemaal plakken op Tabblad B, range("A2:AZ2") (onder de code)
Zie voorbeeldbestand, hier heb ik al wat goede afbeeldingen ingezet.
 

Bijlagen

  • Voorbeeld.xlsx
    94,5 KB · Weergaven: 16
zie bijlage, een kleien variant op de vorige oplossing
de ene macro gooit alle afbeeldingen op de 2e rij weg, anders krijg je daar straks een rommeltje.
De ander gaat in een loopje afbeeldingen aanmaken, kopieren en plakken in de goeie kolom.
 

Bijlagen

  • Voorbeeld (18).xlsb
    233 KB · Weergaven: 22
Of ?

Code: 
Sub M_snb()
   Sheet2.Shapes.SelectAll
   Selection.Delete
   sn = Sheet2.Rows(1).SpecialCells(2)
   
   For j = 1 To UBound(sn, 2)
      Sheet1.Range("A1:G30").CopyPicture
      Sheet2.Paste Sheet2.Cells(2, j)
   Next
End Sub
 
Laatst bewerkt:
cow18 zei:
zie bijlage, een kleien variant op de vorige oplossing
de ene macro gooit alle afbeeldingen op de 2e rij weg, anders krijg je daar straks een rommeltje.
De ander gaat in een loopje afbeeldingen aanmaken, kopieren en plakken in de goeie kolom.
Klik om te vergroten...

Bedankt voor een werkend script, ook handig omdat scaling hierin zit
 
@snb,
daar zitten wel een aantal leuke zaken in :thumb:
 
@snb,
daar zitten wel een aantal leuke zaken in :thumb:
 
@Bergsma,

Is het niet leuk om zelf wat uit te proberen/ te onderzoken ?

Code: 
Sub M_snb()
   Sheet2.Shapes.SelectAll
   Selection.Delete
   sn = Sheet2.Rows(1).SpecialCells(2)
   
   For j = 1 To UBound(sn, 2)
      Sheet1.Range("A1:G30").CopyPicture
      Sheet2.Paste
      With Sheet2.Shapes(Sheet2.Shapes.Count)
         .ScaleHeight 0.9, 0, 1
         .ScaleWidth 0.9, 0, 1
         .Top = Sheet2.Cells(2, j).Top
         .Left = Sheet2.Cells(2, j).Left
      End With
   Next
End Sub
 
Dat is het zeker, ik kan vba scripts redelijk lezen, maar snap soms echt bepaalde functies niet. Ik weet vaak wel redelijk precies wat ik wil, maar heb niet de parate kennis dat om te zetten in code. Het functieboek van Excel zelf kent weinig geheimen voor mij, maar echt goed scripten in vba is nog niet echt aan mij besteed, ik heb wel veel basisscripts verzameld in de loop der tijd, combinaties hiervan gebruik ik en configureer ik op sheets. In dit geval kwam ik er helemaal niet uit zonder hulp.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan