sandra1978
Gebruiker
- Lid geworden
- 21 feb 2011
- Berichten
- 64
Hallo,
Ik heb een macro waarbij ik vanuit een lijst, een sjabloon in laat vullen. Zo creëer ik een x-aantal documenten. Het invullen en opslaan lukt zonder problemen.
Ik moet ook een andere macro laten draaien, waarbij ik de celhoogte van een gemergde cel laat aanpassen. Deze macro werkt op zichzelf wel. Wanneer ik dus een ingevuld document heb, en de 'losse' macro draai.
Wanneer ik hem echter integreer in mijn andere macro, werkt dit niet. Met F8 kan ik alle stappen overlopen en krijg ik ook geen foutmelding. Maar de rijhoogte wordt niet aangepast.
Kunnen jullie mij hier verder helpen?
Alvast bedankt,
Ik heb een macro waarbij ik vanuit een lijst, een sjabloon in laat vullen. Zo creëer ik een x-aantal documenten. Het invullen en opslaan lukt zonder problemen.
Ik moet ook een andere macro laten draaien, waarbij ik de celhoogte van een gemergde cel laat aanpassen. Deze macro werkt op zichzelf wel. Wanneer ik dus een ingevuld document heb, en de 'losse' macro draai.
Wanneer ik hem echter integreer in mijn andere macro, werkt dit niet. Met F8 kan ik alle stappen overlopen en krijg ik ook geen foutmelding. Maar de rijhoogte wordt niet aangepast.
Kunnen jullie mij hier verder helpen?
Alvast bedankt,
Code:
Sub ModulefichesInvullenMetBrondata()
sjabloon = Workbooks("werkdocument_modulefiches.xlsx").Sheets("sjabloon").Range("A1:B28")
brondata = Workbooks("brondata.xlsx").Sheets("brondata").Range("a5:w5") 'usedrange of aangepaste cellen
For j = 1 To UBound(brondata) 'j= ?, aan te passen als je usedrange gebruikt
sjabloon(1, 2) = brondata(j, 4) 'modulenaam
sjabloon(3, 2) = brondata(j, 5) 'lestijden
sjabloon(4, 2) = brondata(j, 10) 'zelfstudie
sjabloon(5, 2) = brondata(j, 11) 'toelatingsvoorwaarden
sjabloon(6, 2) = brondata(j, 12) 'vereiste voorkennis
sjabloon(7, 2) = brondata(j, 13) 'educatief verlof?
sjabloon(11, 1) = brondata(j, 14) 'inhoud module
sjabloon(12, 1) = brondata(j, 17) 'extra info: leerplan/opleidingsprofie
sjabloon(16, 2) = brondata(j, 6) 'inschrijvingsgeld
sjabloon(17, 2) = brondata(j, 8) 'materiaalkosten
sjabloon(18, 2) = brondata(j, 9) 'boek/cursus
sjabloon(19, 2) = brondata(j, 19) 'som totaal
sjabloon(24, 1) = brondata(j, 15) 'werkkledij
sjabloon(27, 1) = brondata(j, 16) 'gereedschap/benodigdheden
Call FixMerged
Sheets("sjabloon").Hyperlinks.Add Range("A12"), Address:=brondata(j, 22)
With Workbooks("werkdocument_modulefiches.xlsx")
.Sheets("sjabloon").Range("A1:B28") = sjabloon
.SaveCopyAs "O:\03_Harde_grafische_technieken_ambachten\14_Communicatie\Website\Modulefiches\to convert\" & brondata(j, 1) & "_" & brondata(j, 4) & ".xlsx"
End With
Next
End Sub
Sub FixMerged() 'Excel VBA to autofit merged cells
Dim mw As Single
Dim cM As Range
Dim rng As Range
Dim cw As Double
Dim rwht As Double
Dim ar As Variant
Dim i As Integer
Application.ScreenUpdating = False
'Cell Ranges below, change to suit.
ar = Array("A11")
For i = 0 To UBound(ar)
On Error Resume Next
Set rng = Range(Range(ar(i)).MergeArea.Address)
rng.MergeCells = False
cw = rng.Cells(1).ColumnWidth
mw = 0
For Each cM In rng
cM.WrapText = True
mw = cM.ColumnWidth + mw
Next
mw = mw + rng.Cells.Count * 0.66
rng.Cells(1).ColumnWidth = mw
rng.EntireRow.AutoFit
rwht = rng.RowHeight
rng.Cells(1).ColumnWidth = cw
rng.MergeCells = True
rng.RowHeight = rwht
Next i
Application.ScreenUpdating = True
End Sub
Laatst bewerkt:
