I am using MS-Access 2007 VBA.
I am attempting to convert a pdf to an image. I found this chunk of code online, but they failed to provide all the references. My compile is failing on vbCFBitmap. Does anyone know where this reference comes from?
Dim MyAcro As New AcroApp
Dim MyPDF As New AcroPDDoc
Dim MyPage As AcroPDPage
Dim MyPt As acrobat.AcroPoint
Dim MyRect As AcroRect
Dim MyData As DataObject
Dim strPathString As String
Dim MyPath As String
Dim SaveToPath As String
Dim mysavepath As String
MyPath = "\\spfs1\stone\Long Term Share\gentex_ppaps\gentex_ppaps_raw\Supplier Request Number 3034910, Gentex Part Number 345-2120-000 Revision (003).pdf"
mysavepath = "C:\out"
' open the PDF
MyPDF.Open (MyPath)
Set MyPage = MyPDF.AcquirePage(0)
' Convert Point to Twips for document
Set MyPt = New AcroPoint
'Define the rectangle that contains the PDF form
Set MyRect = New acrobat.AcroRect
MyRect.Top = 0
MyRect.Left = 0
MyRect.Right = MyPt.x
MyRect.bottom = MyPt.y
' Copy the PDF image to the clip board
Call MyPage.CopyToClipboard(MyRect, MyRect.Left, MyRect.Top, 100)
' Capture image from clip board to data object
Set MyData = Clipboard.GetData(vbCFBitmap)
'Save the data object
SavePicture MyData, mysavepath
' Clean up
Set MyAcro = Nothing
Set MyPDF = Nothing
Set MyPage = Nothing
Set MyPt = Nothing
Set MyRect = Nothing
Set MyData = Nothing
That's likely VB6 code, not VBA.
vbCFBitmap is a system global, and thus not imported using any references.
However, that's just a copy of the Windows Standard Clipboard Formats, thus vbCFBitmap is equal to 2. You can use 2 instead.
Related
Just wanted to add information on the below post (but seems I cant).
https://safeweb.hsbcpb.com/https://stackoverflow.com/questions/39269911/nuance-power-pdf-automation-using-excel-vba-macro
The reference is now:
"C:\Program Files (x86)\Kofax\Power PDF 31\bin\PDFCore8_x64.dll"
even if called powerPDF and the documentation said so to create the with "powerdpdf.app", the following code work fine for me (just in case someone was looking for a solution like I did).
Function copy_pdf_values_wiht_nuance(path As String) As String
Dim PDFApp As Object
Dim dvOpenDoc As Object
Dim ddDoc As Object
Set PDFApp = CreateObject("nuancePDF.App")
Set dvOpenDoc = CreateObject("nuancePDF.DVDoc")
If dvOpenDoc.Open(path) = False Then
PDFApp.Exit
Exit Function
End If
Set ddDoc = dvOpenDoc.GetDDDoc()
PDFApp.MenuItemExecute ("SelectAll")
PDFApp.MenuItemExecute ("Copy")
PDFApp.Exit
'Set ddPage = ddDoc.AcquirePage(0)
'Set hl = CreateObject("NuancePDF.HiliteList")
'hr = hl.Add(12, 1)
'hr = hl.Add(52, 2)
'Set ts = ddPage.CreatePageHilite(hl)
'hr = dvOpenDoc.SetTextSelection(ts)
'dvOpenDoc.ShowTextSelect
Dim clipboard As MSForms.DataObject
Dim strContents As String
Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
strContents = clipboard.GetText
copy_pdf_values_wiht_nuance = strContents
End Function
Copy and paste content of a PDF, having had the wrong reference.
I am trying to generate multiple Word documents which have content controls that are populated from an Excel file. The second content control needs to be populated with a list which varies in length.
How do I add each value to the content control instead of replacing the current value? I am currently using Rich Text Content Controls.
Here is what I have so far:
Sub CreateCoverLetters()
Dim objWord As Word.Application
Dim wDoc As Word.Document
Dim Rows As Integer
Set objWord = CreateObject(Class:="Word.Application")
objWord.Visible = True
Set wDoc = objWord.Documents.Open(*insert filepath*)
objWord.Activate
wDoc.ContentControls(1).Range.Text = Worksheets("Lists").Range("A2").Value
Rows = Worksheets("Lists").Range("A3", Range("A3").End(xlDown)).Rows.Count
r = 3
For i = 1 To Rows
wDoc.ContentControls(2).Range.Text = Worksheets("Lists").Cells(r, 1).Value
r = r + 1
Next
wDoc.SaveAs (*insert filepath*)
End Sub
Any help much appreciated!
Solved it as follows:
Sub CreateCoverLetters()
Dim objWord As Word.Application
Dim wDoc As Word.Document
Dim Rows As Integer
Dim Content As String
Set objWord = CreateObject(Class:="Word.Application")
objWord.Visible = True
Set wDoc = objWord.Documents.Open(*insert filepath*)
objWord.Activate
wDoc.ContentControls(1).Range.Text = Worksheets("Lists").Range("A2").Value
Rows = Worksheets("Lists").Range("A3", Range("A3").End(xlDown)).Rows.Count
r = 3
For i = 1 To Rows
Content = Content & "- " & Worksheets("Lists").Cells(r, 1).Value & vbNewLine
r = r + 1
Next
wDoc.ContentControls(2).Range.Text = Content
wDoc.SaveAs (*insert filepath*)
End Sub
The approach in user's answer works if the content can 1) be concatenated in a single string and 2) none of the elements require special formatting. This would also be the fastest approach.
If for any reason this process is not possible, then the way to "append" content without replacing goes something like in the code snippet that follows.
Notice how Range and ContentControl objects are declared and instantiated, especially the Range object. This makes it much easier to pick up the "target" at a later point in the code. Also, a Range object can be collapsed (think of it like pressing the right-arrow to make a selection a blinking cursor): this makes it possible to append content and work with that new content (format it, for example). Word also has a Range.InsertAfter method which can be used if the new content does not have to be manipulated in any special way.
Dim cc as Object ' Word.ContentControl
Dim rngCC as Object 'Word.Range
Set cc = wDoc.ContentControls(1).Range
Set rngCC = cc.Range
rngCC.Text = Worksheets("Lists").Range("A2").Value
'Add something at a later point
rngCC.Collapse wdCollapseEnd
rngCC.Text = " New material at the end of the content control."
I have a VB.Net program that will open a .dwg and then give the user the ability to add “part blocks” to the drawing.
However, I need to be able to shift all the components in the drawing at one time.
How do I “Select All” from the API in DraftSight? The code below is what I have got started.
'Connect to DraftSight
dsApp = GetObject(, "DraftSight.Application")
'Get active document
dsDoc = dsApp.GetActiveDocument()
If Not dsDoc Is Nothing Then
'Get model space
dsModel = dsDoc.GetModel()
'Get Sketch Manager
dsSketchManager = dsModel.GetSketchManager()
'Basic Command I want to use to Move Selection
' - MOVE
' - Specify Entities = SelectALL
' - Specify Entities = "Enter"
' - Specify from Point = insertX, insertY
' - Specify destination = 0,0
'Move instance parameters
Dim Move_Instance As ISketchManager
Dim insertX As Double
insertX = 5.0
Dim insertY As Double
insertY = 10.0
Dim insertZ As Double
insertZ = 0.0
Dim SelectALL As Object
'Move Selection
Move_Instance = dsApp.GetActiveDocument().GetModel().GetSketchManager.MoveEntities(insertX, insertY, insertZ, SelectALL)
Else
MsgBox("There are no open documents in DraftSight")
End If
After some trial and error, I decide a way to do what I am looking for is to just use the “RunCommand” feature. Below is what I did…
Dim dsApp As DraftSight.Application
Dim dsDoc As DraftSight.Document
Dim dsModel As DraftSight.Model
Dim dsSketchManager As DraftSight.SketchManager
Dim dsViewManager As DraftSight.ViewManager
'Connect to DraftSight
dsApp = GetObject(, "DraftSight.Application")
'Abort any command currently running in DraftSight
'to avoid nested commands
dsApp.AbortRunningCommand()
'Get active document
dsDoc = dsApp.GetActiveDocument()
If Not dsDoc Is Nothing Then
'Get model space
dsModel = dsDoc.GetModel()
'Get Sketch Manager
dsSketchManager = dsModel.GetSketchManager()
Dim dsSheet As DraftSight.Sheet
Dim dsVarSheets As Object
dsVarSheets = dsDoc.GetSheets
dsSheet = dsVarSheets(1)
If dsSheet Is Nothing Then
Return
End If
'Get View Manager
dsViewManager = dsDoc.GetViewManager()
'Select All and Move to location 0,0
Dim Move As Integer
Move = dsApp.RunCommand("MOVE ALL -5.0,-10.0 0.0,0.0", False)
Else
MsgBox("There are no open documents in DraftSight")
End If
Is it possible to export a single CATIA body as STL without creating a separate part with it?
For the time being, I have coded a script which loops through the CATParts present in a folder, fetches the contained bodies and create a single CATPart with each of them and export into stl format.
Dim output_stl_path_HD As String
Dim output_stl_path_MD As String
Dim output_stl_path_SD As String
Dim output_stl_path_via_points As String
Dim output_transformations_path As String
Dim input_path As String
Sub CATMain()
'Path for output file
input_path = CATIA.ActiveDocument.path + "\"
Dim it As Integer
Dim prod As Product
Dim t_p_ref(11)
'List of part names to export
Dim list As Collection
Set list = New Collection
'GET LIST OF CATPART IN FOLDER
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(input_path)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
If (InStr(objFile.path, ".CATPart")) Then
list.Add (objFile.name)
' Set objDocument = CATIA.Documents.Open(objFile.path)
Dim srcDoc As PartDocument
Set srcDoc = CATIA.Documents.Open(objFile.path)
Dim srcPart As Part
Set srcPart = srcDoc.Part
Dim oSel As Selection
Dim bodies1 As Bodies
Dim body1 As body
'
Set bodies1 = srcPart.Bodies
For Each single_body In srcPart.Bodies
A = exportStl(single_body)
Next
Set body1 = srcPart.Bodies.Item(i)
'Dim BoxProduct
'BoxProduct = MsgBox("Quantity of the bodies found:" & srcDoc.Part.Bodies.Count & "", 64)
End If
Next
End Sub
Public Function exportStl(ByVal myBody As body)
Dim oSrc As Part
Dim oTgt As Part
Dim oSrcDoc As PartDocument
Dim oTgtDoc As PartDocument
Dim oBod As body
Dim oSel As Selection
'Sets documents for Source and Target files
Set oSrcDoc = CATIA.ActiveDocument
Set oTgtDoc = CATIA.Documents.Add("Part")
oTgtDoc.Product.PartNumber = myBody.name
'Gets Body to copy
Set oSrc = oSrcDoc.Part
Set oTgt = oTgtDoc.Part
Set oBod = myBody
Set oSel = oSrcDoc.Selection
'Copies Body
oSel.Add oBod
oSel.Copy
Set oSel = oTgtDoc.Selection
'Sets and Pastes in Target file as result with link
oSel.Clear
oSel.Add oTgt.Bodies.Item(1)
oSel.Paste
oSrcDoc.Selection.Clear
CATIA.ActiveDocument.ExportData input_path + myBody.name, "stl"
CATIA.ActiveDocument.Close
End Function
Catia V5 is capable of creating STL files from parts (CatiaPART files), but not from assemblies (CatiaPRODUCT files) or geometrical representations (car files). Therefore, source files, including those saved in a neutral format (STEP or IGES, for example), must be saved as parts. If the source design was saved as an assembly, it is imported to Catia as a product. -
Source : http://www.stratasys.com/customer-support/cad-to-stl/catia
I tried exporting CATBody but was unsuccessful. We must have a CATPart to generate STL
I'm currently trying to control/automate a postcode looking website from postcodes stored and updated in Excel, and my code works perfectly up to the point it has to copy the data once it's finished. For the life of me I can't figure out how to copy the data from the text box / area into Excel without it just putting it ALL into one cell (Text to Columns doesn't really work either).
The website is : http://www.doogal.co.uk/DrivingDistances.php
Sub Geo2()
Dim sht As Worksheet
Dim IE As Object
'Dim ieDoc As HTMLDocument
Dim Item As Variant
Dim objElement As Object
Dim startLoc As String
Dim endLoc As String
Dim x As Integer
Dim objNotes As Object
Dim strNotes As String
Dim str As String
'Dim SignInButton As HTMLInputButtonElement
Set sht = ThisWorkbook.Sheets("Postcode")
Set IE = CreateObject("InternetExplorer.Application")
'Open IE
IE.Visible = True
IE.Navigate "http://www.doogal.co.uk/DrivingDistances.php"
'Wait until site is loaded
Do While IE.ReadyState <> 4 'READYSTATE_COMPLETE
DoEvents
Loop
IE.Document.getElementbyID("startLocs").Value = "dn1 5pq" 'random postcode
IE.Document.getElementbyID("endLocs").Value = "wf12 2fd" 'random postcode
IE.Document.getElementsByName("calculateFor").Item(1).Checked = True
IE.Document.getElementsByName("units").Item(1).Checked = True
IE.Document.getElementsByClassName("btn btn-primary").Item(0).Click
------
'Ive tried without having it as a object and using .value but it either comes with only the first line or the entire thing rammed into a string and is unusable
----Code here is the problem-----
***Set objNotes = IE.Document.getElementbyID("distances")
str = objNotes.Value***
---------
Do While IE.ReadyState <> 4 'READYSTATE_COMPLETE
DoEvents
Loop
End Sub
The following VBA function uses the Google Maps Directions API to calculate the driving distance in meters between two locations. The code is modified from a version submitted by barrowc on this similar question.
Make sure to add a reference in Excel to Microsoft XML, v6.0.
Function getDistance(origin As String, destination As String) As String
Dim xhrRequest As XMLHTTP60
Dim domDoc As DOMDocument60
Dim ixnlDistanceNode As IXMLDOMNode
Dim RequestString As String
Dim API_Key As String
' Insert your own Google Maps Directions API key here
API_Key = "XXXXXX"
' Read the data from the website
Set xhrRequest = New XMLHTTP60
RequestString = "https://maps.googleapis.com/maps/api/directions/xml?origin=" _
& origin & "&destination=" & destination & "&sensor=false&key=" & API_Key
xhrRequest.Open "GET", RequestString, False
xhrRequest.send
' Copy the results into a format we can manipulate with XPath
Set domDoc = New DOMDocument60
domDoc.LoadXML xhrRequest.responseText
' Select the node called value underneath the leg and distance parents.
' The distance returned is the driving distance in meters.
Set ixnlDistanceNode = domDoc.SelectSingleNode("//leg/distance/value")
getDistance = ixnlDistanceNode.Text
Set ixnlDistanceNode = Nothing
Set domDoc = Nothing
Set xhrRequest = Nothing
End Function
Please note that this code by itself violates the Terms of Use of Google's API. "The Google Maps Directions API may only be used in conjunction with displaying results on a Google map; using Directions data without displaying a map for which directions data was requested is prohibited."1
Instead of putting the data all in one string, Split the string into an array, then loop through the array like this:
Set objNotes = IE.Document.getElementbyID("distances")
Dim x as Integer
Dim aDist() as Variant
aDist = Split(objNotes.Value, vbNewLine) 'May need to be vbCr or vbLf or vbCrLf
For x = 0 to Ubound(aDist) - 1
debug.print aDist(x)
Next x