Code in VBA about rotate an image

rikimon2

New Member
Joined
May 6, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
i am very new in codes specially in VBA. My intention was to make a template in excel for reports in my job, it will replace words from excel to a special template in Word and at the end it will load an image from a folder in pc give it other size and rotate for example 90°. this is the code i have done
Sub generar_protocolo_PAT()
Dim ruta_plantilla As String 'this is the ubication of the word's template
ruta_plantilla = Hoja2.[C43] 'this is the ubication in the excel where is the ubication of wor'd template
Dim a_name As String
a_name = Hoja2.[C40] 'this is the name which the report will be saved
Dim ruta_guardado As String
ruta_guardado = Hoja2.[C45] 'this is the ubication of where will be saved in the pc

Dim oWord As Object, wdDoc As Object

Set oWord = CreateObject("Word.Application")
Set wdDoc = oWord.Documents.Open(ruta_plantilla)

oWord.Visible = True
' this part replace some word from excel to the word
For i = 4 To 38
busqueda = Hoja2.Range("D" & i).Text
reemplazar = Hoja2.Range("C" & i).Text
With oWord.Selection.Find
.Text = busqueda
.Replacement.Text = reemplazar
.Execute Replace:=2
End With

Next i
'this is the ubication of the images
Dim ruta_fotA As String
ruta_fotA = Hoja2.[C47] & "\" & Hoja2.[C49] & ".jpg"
Dim ruta_fotB As String
ruta_fotB = Hoja2.[C47] & "\" & Hoja2.[C50] & ".jpg"





' i create a bookmark to put the images in an specifi place

wdDoc.bookmarks("imagen_1").Select

Dim aa As Object
Set aa = wdDoc.InlineShapes.AddPicture(ruta_fotA)

'at this part i rezise de image
aa.Height = Application.CentimetersToPoints(7)
aa.Width = Application.CentimetersToPoints(5)

'i put borders in the image, it is only stetic
aa.Line.Weight = 1
aa.Line.Style = msoLineSingle
aa.Line.ForeColor.RGB = RGB(0, 0, 0)



wdDoc.bookmarks("imagen_2").Select

Dim bb As Object
Set bb = wdDoc.InlineShapes.AddPicture(ruta_fotB)

bb.ScaleHeight = 20
bb.ScaleWidth = 18

bb.Line.Weight = 1
bb.Line.Style = msoLineSingle
bb.Line.ForeColor.RGB = RGB(0, 0, 0)






wdDoc.Activate

wdDoc.SaveAs ruta_guardado & "\" & a_name & ".doc"

Set oWord = Nothing: Set wdDoc = Nothing


End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Try adding this code after "bb.Line.ForeColor.RGB":

VBA Code:
Dim pic As Shape
Set pic = aa.ConvertToShape
pic.Rotation = 90
pic.ConvertToInlineShape
Set pic = bb.ConvertToShape
pic.Rotation = 90
pic.ConvertToInlineShape
 
Upvote 0
Try adding this code after "bb.Line.ForeColor.RGB":

VBA Code:
Dim pic As Shape
Set pic = aa.ConvertToShape
pic.Rotation = 90
pic.ConvertToInlineShape
Set pic = bb.ConvertToShape
pic.Rotation = 90
pic.ConvertToInlineShape
it doesnt work :(, erro 13 the types dont match and the line " set pic=aa.ConvertToShape" is resalted in yellow
 
Upvote 0
Oh, yeah. I was testing the shape code in Word VBA. Try changing

VBA Code:
Dim pic As Shape

to

VBA Code:
Dim pic as Word.Shape

Does it work any better? I can't test right now.
 
Upvote 0
Solution
Oh, yeah. I was testing the shape code in Word VBA. Try changing

VBA Code:
Dim pic As Shape

to

VBA Code:
Dim pic as Word.Shape

Does it work any better? I can't test right now.
omg man thank you, at the begening the program send me an error about type not defined by user, then i add the microsoft office 16.0 library and your code works, thank you so much
 
Upvote 0

Forum statistics

Threads
1,214,864
Messages
6,121,986
Members
449,060
Latest member
mtsheetz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top