vendredi 27 février 2015

Code werkt Via VBA scherm wel maar via Button niet

Posted on 01:36 by Unknown
Beste Leden,



Hieronder staat mijn VBA Code die ik mede door hulp van hier heb weten te maken.



Het werkt alleen goed als ik de code via het VBA windowtje afspeel. Maar zodra ik

de code aan een button hang werkt het niet meer zo goed. De plaatjes op worksheet "trainingsplan" blijven hangen en wisselen niet tijdens dat de code loopt

waardoor uiteindelijk de verkeerde plaatjes onder de namen komen te staan in sheet "PDFLAYOUT".



Zou iemand mij hiermee kunnen helpen?



Heel erg bedankt alvast!



(edit: te snel erop gezet, bij deze)



hieronder volgt de code:






Code:


Sub TestPDFbouwen()



a = 14

b = 1

Do While a < 89

If Sheets("systeemPDFBOUWEN").Cells(a, 6).Value <> "" And Sheets("systeemPDFBOUWEN").Cells(a, 6).Value <> 0 Then

Sheets("Trainingsplan").Cells(3, 2) = Sheets("systeemPDFBOUWEN").Cells(a, 6)

Sheets("Trainingsplan").Cells(6, 3) = Sheets("systeemPDFBOUWEN").Cells(a + 1, 6)

Sheets("Trainingsplan").Cells(6, 6) = Sheets("systeemPDFBOUWEN").Cells(a + 2, 6)

Sheets("Trainingsplan").Cells(13, 3) = Sheets("systeemPDFBOUWEN").Cells(a + 3, 6)

Sheets("Trainingsplan").Cells(13, 6) = Sheets("systeemPDFBOUWEN").Cells(a + 4, 6)

Application.Goto (ActiveWorkbook.Sheets("Trainingsplan").Range("B3: G18"))

Selection.Copy

Application.Goto (ActiveWorkbook.Sheets("PDFLAYOUT").Cells(b, 1))

ActiveSheet.Pictures.Paste.Select

Set Picture = ActiveSheet.Pictures

Picture.ShapeRange.LockAspectRatio = msoTrue

Selection.ShapeRange.ScaleHeight 1.0187328847, msoFalse, msoScaleFromTopLeft

Selection.ShapeRange.ScaleWidth 1.0400295096, msoFalse, msoScaleFromTopLeft

Selection.ShapeRange.ZOrder msoSendBackward

b = b + 44

Sheets("systeemPDFBOUWEN").Cells(14, 8).ClearContents

Sheets("systeemPDFBOUWEN").Cells(15, 8).ClearContents

Sheets("systeemPDFBOUWEN").Cells(15, 9).ClearContents

Sheets("systeemPDFBOUWEN").Cells(16, 8).ClearContents

Sheets("systeemPDFBOUWEN").Cells(16, 9).ClearContents

End If

a = a + 5

Set Picture = Nothing

Sheets("systeemPDFBOUWEN").Select

Loop

End Sub






Code werkt Via VBA scherm wel maar via Button niet
Categories:

0 commentaires:

Enregistrer un commentaire

Inscription à : Publier les commentaires (Atom)