Is there a way to use Excel-VBA code in order to make a picture object in a sheet, so as to insert it as a footer image. I have tried to do so by creating a chart object and pasting it in a picture-format, and then exporting the chart to an image file and setting the image as the footer. Is there a better way to insert a picture object as a footer image, and if so, how do I do it?
I started the macro recorder. I clicked Page Setup then Header/Footer then Custom Footer. I clicked the centre section and then Format Picture (button with image of sun over mountains). I browsed for an image and clicked Insert. "&[Picture]" appeared in the centre section. I clicked OK twice. I switched the macro recorder off.
I printed the page and the selected image appeared at the bottom.
The important code saved by the macro recorder was:
ActiveSheet.PageSetup.CenterFooterPicture.Filename = _
"C:\Users\Public\Pictures\Sample Pictures\Desert Landscape.jpg"
Replace "C:\Users\Public\Pictures\Sample Pictures\Desert Landscape.jpg" with filename of your choice.
The macro recorder is usually the easiest way of discovering statements like this.
For anybody viewing this in the future, I'll share my code to copy a range and save it as a file on your computer, which can then be added to the footer. You can eliminate whatever bits you don't want =)
Dim objPic As Shape
Dim objChart As Chart
Dim strTimeStamp As String
Dim strFileDest As String
20 Sheets(2).Activate
30 Sheets(2).Columns("R:T").AutoFit
40 Sheets(2).Rows("17:21").AutoFit
50 ActiveWindow.DisplayGridlines = False
60 Call Sheets(2).Range("S17", "U21").CopyPicture(xlScreen, xlPicture)
70 ActiveWindow.DisplayGridlines = True
80 Sheets(2).Shapes.AddChart
90 Sheets(2).Activate
100 Sheets(2).Shapes.Item(1).Select
110 Set objChart = ActiveChart
120 ActiveChart.Parent.Name = "FooterChart"
' For some reason, Excel occasionally tries to make an actual chart out of these strings.
' It's just a nonsensical chart that messes the footer up but I'm having trouble duplicating the issue and figuring out what causes it.
' This should always work. Don't use .Clear, it crashes.
130 ActiveChart.ChartArea.ClearContents
140 objChart.Paste
150 Selection.Name = "FooterImage"
160 ActiveSheet.ChartObjects("FooterChart").Activate
170 Sheets(2).Shapes.Item(1).Line.Visible = msoFalse
180 Sheets(2).Shapes.Item(1).Height = Range("S17", "U21").Height
190 Sheets(2).Shapes.Item(1).Width = Range("S17", "U21").Width
200 ActiveChart.Shapes.Range(Array("FooterImage")).Height = Range("S17", "U21").Height
210 ActiveChart.Shapes.Range(Array("FooterImage")).Width = Range("S17", "U21").Width
220 Sheets(2).Shapes.Item(1).Height = Sheets(2).Shapes.Item(1).Height * 1.25
230 Sheets(2).Shapes.Item(1).Width = Sheets(2).Shapes.Item(1).Width * 1.25
240 ActiveChart.Shapes.Range(Array("FooterImage")).Height = ActiveChart.Shapes.Range(Array("FooterImage")).Height * 1.2
250 ActiveChart.Shapes.Range(Array("FooterImage")).Width = ActiveChart.Shapes.Range(Array("FooterImage")).Width * 1.2
260 strTimeStamp = CStr(Format(Now(), "yyyymmddHhNnSs"))
270 strFileDest = "D:\Temp" & strTimeStamp & ".jpg"
280 objChart.Export strFileDest
290 InsertPicture strFileDest
300 If Len(Dir$(strFileDest)) > 0 Then
310 Kill strFileDest
320 End If
330 Sheets(2).Shapes.Item(1).Delete
Try this:
Dim ws as Worksheet
Set ws = Worksheets("YourWorksheetName")
With ws.PageSetup
.CenterFooterPicture = "&G" 'Specifies that you want an image in your footer
.CenterFooterPicture.Filename = "C:\Pictures\MyFooterImage.jpg" 'specifies the image file you want to use
End With
The code generated by the macro recorder will get you part of the way there, but as is often the case, it doesn't provide the whole or most appropriate solution. It also sounds like you are trying to insert an image generated by Excel (such as a chart) into the footer? if that's the case, I believe you will have to same the object as an image and then reference that image file.
Related
I have a picture box and I print contents in it. I want to know the exact textwidth of the text in millimeters. But I get wrong value. here is my code
me.scalemode = vbmillimeters
picturebox.scalemode = vbmillimeters
picturebox.fontname = "Arial"
picturebox.fontsize = 12
debug.print textwidth("AB.C.D.E. FGHIJKLMN")
When i measure in the printout in paper it is 48 mm
but it shows 32.97mm
please help me where am wrong.
Thanks in advance
If you need the width of the text printed to the picture box, use:
PictureBox.textwidth("AB.C.D.E. FGHIJKLMN")
What you are actually doing: textwidth("AB.C.D.E. FGHIJKLMN") is mesuring the same text printed to the Form (Me).
Doing like this would be less error-prone:
Dim TextWidth as Single
With PictureBox
.ScaleMode = vbMillimeters
.FontName = "Arial"
.FontSize = 12
TextWidth = .TextWidth("AB.C.D.E. FGHIJKLMN")
End With
because if you are then switching to paper, you can also easily switch context:
With SelectedPrinter....
I am having issues with inserting a picture in portrait mode using VBA. If the picture is in landscape mode, then the picture is inserted into the associated shape in column B. However, if the picture is in portrait, then the picture is offset 25 columns to column AA. Any help is greatly appreciated!
Sub cmdInsert1_Click()
Dim myPicture As String, MyObj As Object
Range("b5").Select
myPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
If myPicture = "False" Then Exit Sub
Set MyObj = ActiveSheet.Shapes.AddPicture(myPicture, False, True, Range("B5").Left, Range("B5").Top, -1, -1)
With MyObj
.Height = 293
.Locked = False
End With
Set MyObj = Nothing
End Sub
Windows "remembers" the orientation of the picture, so what is in the Top Left corner of your screen may not actually be the Top Left corner of the picture. You will need to check the .Rotation property of your picture. If it's rotated (ie, not 0), you will need to adjust your code accordingly. For example:
If myObj.Rotation = 0 Or myObj.Rotation = 180 Then
.Height = 293
Else
.Width = 293
End If
Edit: Forgot to account for it merely being upside down
I am facing below issue in VB6 :
When I checkout file file and check "Show differences" it is showing no difference (identical files) but when I save my changes without changing and form property and again check for differences in VSS , it is showing difference in few property.One of them is mentioned below.Kindly suggest.
Begin VB.Label CommStatus
BackColor = &H80000014&
BorderStyle = 1 'Fixed Single
BeginProperty Font
**Name = "Arial"** 'this property is changing
Size = 8.25
Charset = 204
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 375
Left = 240
TabIndex = 3
ToolTipText = "The most recently detected error"
Top = 360
Width = 7815
End
You can check attach image
After looking in to this, the reason for seems to be Windows zoom setting (100%,125% and 150%, control panel/Make text and other items larger or smaller). If the form is checked in to TFS/VSS/GIT in one zoom setting, and later edited in another, VB6 will change all kind of form properties to adjust for this. So this probably only happens in dev teams with 2+ users that happens to have different screen sizes and therefor different zoom settings.
Only way to avoid this is probably to all use the same zoom setting...
I have written a VBScript to automate the creation of a Word document.
I'm using the following code to insert an image, but I can't seem to find a way to then resize it.
objSelection.InlineShapes.AddPicture("C:\test.jpg")
The AddPicture method returns a handle to the inserted object, so you could do something like this:
Set pic = objSelection.InlineShapes.AddPicture("C:\test.jpg")
pic.Height = 100
pic.Width = 200
I have a workbook that has 54 sheets. "Master" Totals" and "Week1" through "Week52"
I am trying to insert an image from a file to a cell on the sheets "Week1" through to "Week52".
I have tried many codes and am able to get the image placed and sized correctly
the codes below both placed the image and I was able to manipulate them to get the image in the right spot and the right size.
I can't however make them run through the other sheets (Week1 through Week52)
Set oPic = Application.ActiveSheet.Shapes.AddPicture("C:\Users\Public\Documents\Cranes\MinerPic.wmf", False, True, 1, 1, 1, 1)
oPic.ScaleHeight 0.3, True
oPic.ScaleWidth 0.3, True
oPic.Top = Range("p2").Top
oPic.Left = Range("p2").Left
.OnAction = "FC4.xlsm!MineSheet"
or
pPath = "C:\Users\Public\Documents\Cranes\MinerPic.wmf"
With ActiveSheet.Pictures.Insert(pPath)
.Left = Range("p2").Left
.Top = Range("p2").Top
.ShapeRange.Height = 50
.ShapeRange.Width = 50
.OnAction = "FC4.xlsm!MineSheet"
At one stage I was able to place 52 images on top of each other. I suspect this has something to do with the Activesheet command.
I am extremely new to VBA and would appreciate any help.
Thanks in advance.
Steve.
Wrap your code like this
For i = 1 To 52
Set sh = ActiveWorkbook.Worksheets("Week" & i)
' Reference the sh object rather than ActiveSheet
Set oPic = sh.Shapes.AddPicture( ...
' or
With sh.Pictures.Insert(pPath)
' rest of your code
Next