I wrote a piece of code that crops a pdf page and then re-insert this page in the global pdf using the Adobe Acrobat 10.0 Type Library for Excel VBA.
The code works fine on my computer but crops too much on the one of my co-worker. I think it might come from the resolution (1440x900 for mine, 1600x900 for my co-worker) but I just don't see where the resolution might interfer in the code.
Dim acroRect, jso, page As Object
Dim pdf1 As Acrobat.CAcroPDDoc
Dim nameFile, s, exportCroppedPDF As String
Set acroRect = CreateObject("AcroExch.Rect")
Set pdf1 = CreateObject("AcroExch.PDDoc")
nameFile = "namefile.pdf"
If pdf1.Open(nameFile) Then
Set jso = pdf1.GetJSObject
Set page = pdf1.AcquirePage(pdf1.GetNumPages() - 1)
'These values were found from some tests I did, there is no logic behind them
acroRect.bottom = 22
acroRect.Left = 35
acroRect.Right = 785
acroRect.Top = 589
page.CropPage (acroRect)
exportCroppedPDF = "pathAndNamefile.pdf"
s = jso.extractPages(0, pdf1.GetNumPages() - 1, exportCroppedPDF)
Else
Debug.Print ("Can't open the file!")
End If
pdf1.Close
Set pdf1 = Nothing
Set acroRect = Nothing
Set jso = Nothing
Set page = Nothing
Debug.Print ("Crop successful")
I am not cumfortable at all with this library (the code comes from pieces of code I found on the Internet) so I might have wrote some wrong lines (but it initialy works).
Thanks a lot for your help!
According to the documentation CropPages has 4 arguments where acroRect should be the last one.
returnValue = Object.CropPages( nStartPage, nEndPage, nEvenOrOddPagesOnly, acroRect )
Parameters:
nStartPage: First page that is cropped. The first page in a PDDoc object is
page 0.
nEndPage: Last page that is cropped.
nEvenOrOddPagesOnly Value indicating which pages in the range are cropped. Must be
one of the following:
0 means crop all pages in the range
1 means crop only odd pages in the range
2 means crop only even pages in the range
acroRect An AcroExch.Rect specifying the cropping rectangle, which is
specified in user space.
Related
I am having a problem trying to get a Web Browser control in a MS Access form to display an image from a URL correctly.
I am using .navigate (strImagePath) to place the imaging in to WebBrowser1. That works fine. The images are jpg and I have the full path and image filename.
The problem is the that the image is displayed at 100% scale, which is larger than the size of the browser. I can use zoom (OLECMDID_OPTICAL_ZOOM) to scale the image, but this only works if I know the size of the image, which I don't to get the right zoom factor.
Ideally, I would like to have the image fit to window without having to determine the image size.
It that is not possible, the other option is to determine the image size and then set the appropriate zoom. I have not figured a way to determine the image size without saving it locally. Which would be a big overhead and add a unacceptable lag to the form display, specially when move through records. Any ideals here?
Thanks
I was able to get it running after the code from Thomas.
There is the final code.
Public Function DisplayImage(ctlImageControl As Control, strImagePath As Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim intHeight As Integer
Dim intWidth As Integer
Dim intHeightZoom As Integer
Dim intWidthZoom As Integer
Dim intPageZoom As Integer
With ctlImageControl
If strImagePath = "" Then
.Visible = False
strResult = "No image name specified."
Else
.Visible = True
.Navigate (strImagePath)
Do While .Object.Busy Or .Object.ReadyState <> 4 'wait to imaged loaded
DoEvents
Loop
intHeight = .Document.images(0).clientHeight
intWidth = .Document.images(0).clientWidth
intHeightZoom = CLng(21600) / intHeight
intWidthZoom = CLng(43200) / intWidth
If intHeightZoom < intWidthZoom Then
intPageZoom = intHeightZoom
Else
intPageZoom = intWidthZoom
End If
.Object.ExecWB OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, _
CLng(intPageZoom), vbNull
strResult = "success"
End If
End With
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the specified name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying image."
Resume Exit_DisplayImage:
End Select
End Function
There the function is called by
Me!txtFaceResults = DisplayImage(Me!WebBrowser1, strFullImageName)
While it works to zoom the images to a uniform size, the scaling is still off. But the general process works of loading the images in to the ActiveX Web Browser object. Reads the image size and calculates a zoom factor and then apply the zoom. It is important to wait for the image to load, otherwise you will either get an error or the size of the previously loaded image.
I was not able to use HtmlImg Type as Thomas used, so I got the elements individually. I used the documentation on Mozilla at:
https://developer.mozilla.org/en-US/docs/Web/API/Element
to see the element available.
If you have only the image loaded, the following code will get you the width and height of that image.
Dim img As HtmlImg
Set img = Me.WebBrowser1.Document.images(0)
Debug.Print img.naturalHeight, img.naturalWidth
However, I was not really able to calculate the correct zoom factor nor to pass a variable zoom factor to the ExecWB-method - I always got a runtime error, not matter which data type I used (constant values are working).
Plus, at least in my tests, the image was displayed with (white) borders which also would influence the zoom factor. Anyhow, the width and height are exactly the dimensions of the test image I was playing with.
I am trying to ensure that I am addressing entities in ModelSpace, but I get an exception that gives no hint at what the problem is because it's a COM object I guess. Does anyone know what I might be doing wrong? If I take out that line (and the zoom extents line) the remaining code works just fine, so I know my document object is being set correctly.
Dim acDWG As AutoCAD.AcadDocument
' open the drawing
acDWG = acApp.Documents.Open(dgvr.Cells("FullName").Value.ToString)
' ensure the drawing has the modelspace tab activated (doesnt work)
acDWG.ActiveSpace = AutoCAD.AcActiveSpace.acModelSpace
' zoom to extents (sometimes works, sometimes not) '
acApp.ZoomExtents()
' build a selectionset of all blocks named 'Solid1' and then delete them all
Dim ss As AutoCAD.AcadSelectionSet = acDWG.SelectionSets.Add("DELETE")
Dim gpCode(1) As Int16
Dim dataValue(1) As Object
gpCode(0) = 0 : dataValue(0) = "Insert"
gpCode(1) = 2 : dataValue(1) = "Solid1"
ss.Select(AutoCAD.AcSelect.acSelectionSetAll,,, gpCode, dataValue)
ss.Erase()
ss.Delete()
ss = Nothing
Update: I discovered why I am getting the error. The code is correct, but the problem is that the drawing has not completed opening yet. If I put a "wait for 5 seconds" line of code directly after the Open line, it works just fine. So it seems my question is how to open the drawing and have VB.Net wait for a signal from the COM object that it is "ready to continue"? (not sure how to word it)
Use a combination of Do...Loop and a Try...Catch block to "wait" like this:
Dim acDWG As AutoCAD.AcadDocument
acDWG = acApp.Documents.Open(dgvr.Cells("FullName").Value.ToString)
Dim bOpen As Boolean = False
Do Until bOpen = True
Try
acDWG.ActiveSpace = AutoCAD.AcActiveSpace.acModelSpace
bOpen = True
Catch ex As Exception
' ignore the error and try again until it is open
End Try
Loop
I am using Visual Studio 2015 and coding in vb.net and importing Microsoft.Office.Interop.Word . I am using the following code to create a one page Word document with only two lines. How can I center, both vertically and horizontally these two lines? Also, is there a way to put both lines, with a line break in between, in one paragraph rather than using two? I am very new to this type of programming so please be specific. Thanks.
Private Sub CreateTitlePage2()
Dim wdApp As Microsoft.Office.Interop.Word.Application = New Microsoft.Office.Interop.Word.Application
Dim wdDoc As Microsoft.Office.Interop.Word.Document = New Microsoft.Office.Interop.Word.Document
Dim wdPara1 As Microsoft.Office.Interop.Word.Paragraph
Dim wdPara2 As Microsoft.Office.Interop.Word.Paragraph
wdDoc.Application.Visible = False
wdPara1 = wdDoc.Content.Paragraphs.Add
wdPara1.Range.ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphCenter
wdPara1.Range.Font.Bold = True
wdPara1.Range.Text = "BINDER DOCUMENT"
wdPara1.Range.InsertParagraphAfter()
wdPara2 = wdDoc.Content.Paragraphs.Add
wdPara2.Format.SpaceBefore = WdVerticalAlignment.wdAlignVerticalCenter
wdPara2.Range.Font.Bold = True
wdPara2.Range.Text = "Created: " + formattedDate2
wdPara2.Range.InsertParagraphAfter()
wdDoc.SaveAs(binderNameDoc)
wdDoc.Close()
wdApp.Quit()
End Sub
#Ross: It would help if you'd describe HOW it's "not working". However...
WdVerticalAlignment is not valid applied to a paragraph object, I'm surprised you're not getting a compiler error. See https://msdn.microsoft.com/en-us/library/aa224305(v=office.11).aspx.
If you want to center something vertically on the page then it must be done via the PageSetup object and then it will apply to the entire SECTION. See https://msdn.microsoft.com/en-us/library/office/ff838676.aspx?f=255&MSPPError=-2147217396
If you document is really only the one page, as you say, then you don't need to worry about the SECTION part as the document will have only the one.
RE Line break: Insert ANSI 11 character (vbVerticalTab) for a line break (what you get when pressing Shift+Enter in the Word application).
I wrote a simple macro function in VBA for Excel to extract text appearing in a particular location in an HTML document, first retrieving the HTML document from a URL value in another cell. The macro function itself is not important, except for the fact that it sends an HTTP request and creates an HTML file object, which I fear will cause Excel to crash if I paste, say, a column of 100 or more URLs and it starts trying to calculate all the values at once. I can see that it stops and churns for a moment if I drag the formula down 10 cells where there is already a column of URLs. Is there a setting to force Excel to calculate one formula at a time, so that it may take longer but is less likely to freeze up or crash?
Update: I incorporated a static collection variable into the function to at least avoid repeated slowdowns retrieving the same HTML in the same worksheet:
Function GetUSPatentAbstract(ByVal url As String) As String
Static colAbstract As New Collection
Dim abstract As String
On Error Resume Next
abstract = colAbstract(url)
`If there is no abstract for the URL in the collection yet, then it is retrieved:
If Err.Number <> 0 Then
Dim description As String
Dim abstractStart As Long
Dim abstractEnd As Long
Dim abstractLength As Long
Set html_doc = CreateObject("htmlfile")
Set xml_obj = CreateObject("MSXML2.XMLHTTP")
xml_obj.Open "GET", url, False
xml_obj.send
html_doc.body.innerhtml = xml_obj.responseText
Set xml_obj = Nothing
description = html_doc.body.innertext
abstractStart = InStr(description, "Abstract") + 8
abstractEnd = InStr(description, "Inventors:")
abstractLength = abstractEnd - abstractStart
abstract = Mid(description, abstractStart, abstractLength)
colAbstract.Add Item:=abstract, Key:=url
End If
On Error GoTo 0
GetUSPatentAbstract = abstract
End Function
I am using OO 3.0 and according to the official openoffice documentation (http://wiki.services.openoffice.org/wiki/Documentation/BASIC_Guide/StarDesktop) in order to replace the document this is the code required:
Dim Doc As Object
Dim Dummy()
Dim Url As String
Dim SearchFlags As Long
SearchFlags = com.sun.star.frame.FrameSearchFlag.CREATE + _
com.sun.star.frame.FrameSearchFlag.ALL
Url = "file:///C:/test.odt"
Doc = StarDesktop.loadComponentFromURL(Url, "MyFrame", SearchFlags, Dummy)
MsgBox "Press OK to display the second document."
Url = "file:///C:/test2.odt"
Doc = StarDesktop.loadComponentFromURL(Url, "MyFrame", SearchFlags, Dummy)
I tried it and it is not working, tried both from VB and OO Basic
what am I missing ?
(I used all flags 23+8 and even 55 as the search flags mask)
After reading more example scripts I tried setting the fame name manually:
vFrame = ThisComponent.CurrentController.Frame
REM Here we set the frame name manually
vFrame.setName("MyFrame")
While using loadComponentFromURL seems not to change the frame name, using the setName does change the frame name so after the first call to loadComponentFromURL I changed the frame using setName, and from now on it si working as expected