CommandButton om foto in te voegen in word

Status
Niet open voor verdere reacties.

rensburghgraaff

Nieuwe gebruiker
Lid geworden
31 jul 2012
Berichten
4
Ik ben aan het tobben om een commandbutton te maken om een foto op een bepaalde plaats in te laten voegen.
De foto moet van de schijf geselecteerd worden zoals je normaal doet met het invoegen van een afbeelding.

de application.GetOpenFilename krijg ik in word gewoon niet werken.

heeft iemand een voorbeeld / de oplossing?

Alvast bedankt!
 
Na een berg haarverlies en getob heb ik dit voor elkaar gekregen.
De foto word zo bij het woord gebrek1 ingevoegd.

Nu zit ik er alleen mee dat de foto boven de tekst zweeft, hoe krijg ik die als in de tekstregel?

Heeft iemand een idee?

gr. Rens


Private Sub cbgebrekenfoto1_Click()

Word.Selection.Find.Text = "gebrek1"
Word.Selection.Find.Forward = True
Word.Selection.Find.Wrap = wdFindContinue
Word.Selection.Find.Format = False
Word.Selection.Find.MatchCase = False
Word.Selection.Find.MatchWholeWord = False
Word.Selection.Find.MatchWildcards = False
Word.Selection.Find.MatchSoundsLike = False
Word.Selection.Find.MatchAllWordForms = False

Word.Selection.Find.Execute

Dim sh As Shape
Dim sngCropsize As Single
Dim dlg As Dialog
Dim sngTop As Single
Dim sngLeft As Single
Dim sngOrigHeight As Single
Dim sngOrigwidth As Single
Dim sngNewheight As Single
Dim sngNewwidth As Single
Dim sngNewCropsize As Single

Set dlg = Dialogs(wdDialogInsertPicture)

If dlg.Display = -1 Then
Set sh = ActiveDocument.Shapes.AddPicture(dlg.Name, False, True, , , , , Selection.Range)
sngTop = sh.Top
sngLeft = sh.Left
With sh.Duplicate
.ScaleHeight 1, msoTrue
sngOrigHeight = .Height
sngOrigwidth = .Width
.Delete

End With

sngCropsize = sh.Width - sh.Height
sh.LockAspectRatio = True

If sngCropsize > 0 Then
sh.Width = CentimetersToPoints(7)
sngNewheight = sh.Height
sngNewCropsize = (sngNewheight - CentimetersToPoints(7)) / 2

If sngNewCropsize > 0 Then
sh.PictureFormat.CropTop = sngNewCropsize
sh.PictureFormat.CropBottom = sngNewCropsize
End If


Else
sh.Height = CentimetersToPoints(1.16)
sngNewwidth = sh.Width
sngNewCropsize = (sngNewwidth - CentimetersToPoints(7)) / 2

If sngNewCropsize > 0 Then
sh.PictureFormat.CropRight = sngNewCropsize
sh.PictureFormat.CropLeft = sngNewCropsize
End If

End If

End If



End Sub
 
Zou je de code nog willen opmaken met de CODE knop? (knop # ) Dat maakt hem een stuk leesbaarder.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan