The program I have been writing reads information from various sources in the workbook, rearranges the information into several compact tables on separate sheets, and then copies those tables as images into a separate summary sheet. I have written this program as several different sub routines that are called on by the main program.
When the main program runs, the images it pastes into the summary sheet have the correct dimensions and placement, but they are completely white. However, when I run the sub routine responsible for copying those images over, it succeeds in actually copying the correct tables. Here is the code I am using to copy and past the tables, as images:
Sub ExtractToPresentation()
Call UnprotectAll
Application.DisplayAlerts = False
Application.CutCopyMode = False
startcell = Worksheets("Supplier Comparison").Cells(1, 1).Address
bottomcell = Worksheets("Supplier Comparison").Cells(21, 14).Address
Set copyrng = Worksheets("Supplier Comparison").Range(startcell, bottomcell) '.SpecialCells(xlCellTypeVisible)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(SupSt)
End With
The sub routine continues, but the rest is a variation on the above code for each additional table:
startcell = Worksheets("Rating Criteria").Cells(1, 1).Address
bottomcell = Worksheets("Rating Criteria").Cells(12, 7).Address
Set copyrng = Worksheets("Rating Criteria").Range(startcell, bottomcell)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(CritSt)
End With
startcell = Worksheets("Comments").Cells(1, 1).Address
bottomcell = Worksheets("Comments").Cells(4, 14).Address
Set copyrng = Worksheets("Comments").Range(startcell, bottomcell)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(CommSt)
End With
startcell = Worksheets("Component Table").Cells(1, 1).Address
bottomcell = Worksheets("Component Table").Cells(CompH, CompW).Address
Set copyrng = Worksheets("Component Table").Range(startcell, bottomcell)
copyrng.CopyPicture xlScreen, xlBitmap
With Worksheets("Presentation")
.Paste _
Destination:=.Range(CompSt)
End With
Application.DisplayAlerts = False
Call ProtectAll
End Sub
The variables ending in St, H, and W are defined in a previous program that determines the size of each table. I have no idea why this program functions perfectly on its own, but returns blank images when run after other programs.
Let me know if anyone wants to look at other parts of my code. There are ~500 lines in this program, and I didn't want to dump everything all at once.
Try application.screenupdating = true also displayalert - true, and see if it works.
I was having the same problem while copying object from excel to PPT, and when I made screeupdating = true(default), it started working :-)
Swarup
Try
Range(*source*).Copy ' full source range
' asume you have a destination cell as a range
*destination*.Parent.Select ' select sheet
*destination*.Select ' select dest cell
*destination*.Parent.Pictures.Paste ' paste
If you need to resize the image, use
*sheet*.Shapes(x).Height
*sheet*.Shapes(x).Width
working example:
Sub Test()
Set src = Sheets("Sheet1").Range("A1", "B4")
Set dst = Sheets("Sheet2").[C5]
src.Copy
dst.Parent.Select
dst.Select
dst.Parent.Pictures.Paste
src.Parent.Select
src.Select
End Sub
I am inserting over 3.000 pics from several files and sometimes this problem appeared as well.
I could solve the problem by inserting a short break [ Sleep(25) ] followed by [ DoEvents ] right after the insertion and placement of the picture.
No ScreenUpdating needed...
Related
I've attempted the solution in the following.
Inserting an Online Picture to Excel with VBA
Unfortunately I get a run-time error '1004'
"Unable to get the Insert property of the Picture class"
which stops on the following code :
Set myPicture = ActiveSheet.Pictures.Insert(pic)
Could this be due to my Office version 2016 (64bit) ?
If not, are there any suggestions of how I might get embed images to adjacent cells in column AK using the image urls from column AJ ?
Thanks in advance
There's some evidence that Excel has trouble downloading from AWS, and I've recreated your issue using the URL you mentioned. In this case, if I were on a deadline I'd put in this fall-back method when the first one fails: download the file, then insert it into the document, then delete the file.
directDownloadFailed:
Dim FileNum As Long
Dim TempFile As String
Dim FileData() As Byte
Dim WHTTP As Object
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
WHTTP.Open "GET", imgURL, False
WHTTP.Send
FileData = WHTTP.ResponseBody
Set WHTTP = Nothing
FileNum = FreeFile
TempFile = "path\to\save\img.jpg"
Open TempFile For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
Set img = ActiveSheet.Pictures.Insert(TempFile)
SetAttr TempFile, vbNormal
Kill TempFile
GoTo resumeProcessingImg
#keydemographic
I appreciate the response and that definitely sounds like an option but I cannot get that code to work or incorporate it into the code I'm using. I get a compile error "Label Not defined" on GoTo resumeProcessingImg
The following will download and embed the images into the cells but the code stops once it gets to the s3 aws image urls.
I'll try a few other ways to incorporate your code but I'm not having much luck with it so far.
This is my test file
Sub URL2IMG()
Dim pic As String 'path of pic
Dim myPicture As Picture 'embedded pic
Dim rng As Range 'range over which we will iterate
Dim cl As Range 'iterator
Set rng = Range("b2:b12") '<~~ as needed, Modify range to where the images are to be embedded.
For Each cl In rng
pic = cl.Offset(0, -1) '<~~ defines image link URL in column to the left of the embedded column
Set myPicture = ActiveSheet.Pictures.Insert(pic)
'you can play with the following to manipulate the size & position of the picture.
With myPicture
.ShapeRange.LockAspectRatio = msoFalse
' currently this shrinks the picture to fit inside the cell.
.Width = cl.Width
.Height = cl.Height
.Top = Rows(cl.Row).Top
.Left = Columns(cl.Column).Left
End With
Next
End Sub
Background:
Entry is via a subform for adding/showing/linking images.
I do not want to store the image files within my DB, the image folder is separate. The DB will grow rather large in time.
I have created a click-control enabling a popup for user to browse and click on the imagePATH to be added in a Bound Textfield (called Bildadress, no not misspelled in My country, Grin ) in the subform.
See code below.
Then I add a new unbound Image-control and specify its Controlsource = the Textfield mentioned above.
For the firs image this works wonderful, but for the following the Image-control returns NULL (not show att all). The data in the Textfield updates as it should.
Will the 2nd stage only work in a 1:1 relationship OR can I (with your help) use VBA code to make this work?
OPTIMAL would be to get this to work and also a 2nd Bound Textfield just displaying the actual image file name. .
I hope someone out there have encountered this problem who also didnt want to use Attachment to store the files within the databae.
CODE:
Private Sub AddFilePath_Click()
Call Selectfile
End Sub
Public Function Selectfile() As String
Dim Fd As FileDialog
Set Fd = Application.FileDialog(msoFileDialogOpen)
With Fd
.AllowMultiSelect = False
.Title = "Välj önskad fil"
If .Show = True Then
Selectfile = .SelectedItems(1)
Me.Bildadress = Selectfile
Else
Exit Function
End If
End With
Set Fd = Nothing
End Function
If you use a bound textbox that holds the image-path then you can use
Me.Imagecontrol.Picture = Me.BoundTextControl.Value
to load the picture into an unbound image control. In your case that would be something like
If .Show = True Then
Me.Bildadress.value = .SelectedItems(1)
Me.Bild.Picture = Me.Bildadress.value
Else
It would be best to also load the respective picture in the OnCurrent Event.
Private Sub Form_Current()
Me.Bild.Picture = Me.Bildadress.value
End Sub
However, keep in mind that access is a one-file-database and you break that paradigm when using links to external files where the files would belong into the DB.
I have a workbook full of text and image hyperlinks, I've got some code that will deal with the text URLs nicely, however, the image links are presenting a problem as they don't sit in the flow of the page to be able to pull those links. I don't know how VBA treats these as objects, is it possible to target or cycle through them to pull out their URLs?
Try this way (I used your code and put some error handling instructions):
Sub test()
Dim WriteRow As Integer
WriteRow = 1
Dim imglink As Shape
'error handling
On Error Resume Next
For Each imglink In Sheets(1).Shapes
'if any shape doesn't have hyperling we would skip it
ActiveWorkbook.Sheets(3).Cells(WriteRow, 1).Value = imglink.Hyperlink.Address
If Err.Number = 0 Then
WriteRow = WriteRow + 1
Else
Err.Clear
End If
Next
End Sub
I expect that you have an error each time you check Hyperlink for shape which doesn't have one.
I have many power point slides and each slide has many lines but all those lines are in the same objects. I want now to add some animation including appears for each line with click.
How I can partition the lines in each slide such that every line will be in its own object
Note, I am using powerpoint 2010
Thanks,
AA
This isn't perfect; you'll need to add more code to pick up ALL of the formatting from the original text, but it's a start. Click within the text box you want to modify, then run the TEST sub. Once it's adjusted to your taste, it's a fairly simple matter to extend it to act on every text box in the entire presentation (though not tables, charts, smartart, stuff like that)
Sub Test()
TextBoxToLines ActiveWindow.Selection.ShapeRange(1)
End Sub
Sub TextBoxToLines(oSh As Shape)
Dim oSl As Slide
Dim oNewShape As Shape
Dim oRng As TextRange
Dim x As Long
With oSh
Set oSl = .Parent
With .TextFrame.TextRange
For x = 1 To .Paragraphs.Count
Set oRng = .Paragraphs(x)
Set oNewShape = oSl.Shapes.AddTextbox(msoTextOrientationHorizontal, _
oRng.BoundLeft, oRng.BoundTop, oRng.BoundWidth, oRng.BoundHeight)
With oNewShape
.TextFrame.AutoSize = ppAutoSizeNone
.Left = oRng.BoundLeft
.Top = oRng.BoundTop
.Width = oSh.Width
.Height = oSh.Height
With .TextFrame.TextRange
.Text = oRng.Text
.Font.Name = oRng.Font.Name
.Font.Size = oRng.Font.Size
' etc ... pick up any other font formatting you need
' from oRng, which represents the current paragraph of
' the original text
' Bullets, tabs, etc.
End With
End With
Next
End With
End With
oSh.Delete
End Sub
I have an Excel 2007 Worksheet with many buttons and labels that act as menu options (i.e. user clicks the buttons, labels with images) and is presented with forms, or some thing else.
These images / icons for the buttons and labels are loaded in VBA by assigning the Picture property of the Control and calling LoadPicture() method with the full image file path as parameter, like So.
With SomeFormObject
.cmdOpenFile.Picture = LoadPicture("F:\projectname\images\fileopen.BMP")
End With
This method of loading images for buttons, other controls is causing 2 issues.
1) It creates a dependency on the image files and physical location for every user, so if a user does not have the drive mapped and files present, the VBA fails with runtime error of file or path not found.
2)
The app gets very slow if the images are on a shared drive (which is the case)
I want to eliminate both issues and somehow load icons, images into control internally, without any external dependencies on external image files.
What is the best way to achieve this in Excel 2007 VBA?
I could not file any Visual Basic 6.0 / Visual Studio style "Resource File Editor" / feature with which to accomplish this.
Please advice! thank you
-Shiva #
mycodetrip.com
I really hope that there is a easier way to do this, but this is the only one I found:
The Idea is:
You keep the Pictures embedded in a Sheet and every time you want to set the pictures for the Command you export them from your worksheet to a file and load them through LoadPicture. The only way to export an embedded Picture through VBA that I found is by making it a Chart first.
The following code is based on 'Export pictures from Excel' from johnske
Option Explicit
Sub setAllPictures()
setPicture "Picture 18", "CommandButtonOpen"
setPicture "Picture 3", "CommandButtonClose"
End Sub
Sub setPicture(pictureName As String, commandName As String)
Dim pictureSheet As Worksheet
Dim targetSheet As Worksheet
Dim embeddedPicture As Picture
Dim pictureChart As Chart
Dim MyPicture As String
Dim PicWidth As Long
Dim PicHeight As Long
Set pictureSheet = Sheets("NameOfYourPictureSheet") ' <- to Change '
Set targetSheet = Sheets("NameOfYourSheet") ' <- to Change '
Set embeddedPicture = pictureSheet.Shapes(pictureName).OLEFormat.Object
With embeddedPicture
MyPicture = .Name
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=pictureSheet.Name
Set pictureChart = ActiveChart
embeddedPicture.Border.LineStyle = 0
With pictureChart.Parent
.Width = PicWidth
.Height = PicHeight
End With
With pictureSheet
.Select
.Shapes(MyPicture).Copy
With pictureChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:="temp.jpg", FilterName:="jpg"
End With
pictureChart.Parent.Delete
Application.ScreenUpdating = True
targetSheet.Shapes(commandName).OLEFormat.Object.Object.Picture = LoadPicture("temp.jpg")
Set pictureChart = Nothing
Set embeddedPicture = Nothing
Set targetSheet = Nothing
Set pictureSheet = Nothing
End Sub
Sub listPictures()
' Helper Function to get the Names of the Picture-Shapes '
Dim pictureSheet As Worksheet
Dim sheetShape As Shape
Set pictureSheet = Sheets("NameOfYourSheet")
For Each sheetShape In pictureSheet.Shapes
If Left(sheetShape.Name, 7) = "Picture" Then Debug.Print sheetShape.Name
Next sheetShape
Set sheetShape = Nothing
Set pictureSheet = Nothing
End Sub
To Conclude:
Loading the Images from a Mapped Networked Drive seems less messy, and there shouldn't be that much of a speed difference.
2 alternatives i can think of: form.img.picture=pastepicture , and = oleobjects("ActiveXPictureName").object.picture.