I am trying to insert text and pictures from a specific folder to a hidden Excel file, in specific cells, but for some reason I do not succeed in adding the pictures to the file.
What I can is open a hidden Excel file and add a bunch of data to the Excel. I can also add pictures tot the Excel from which the VBA script is running.
However combining both is something where I fail.
I use the following code to open an Excel file and put data in there:
Dim ExcelFileName As String
ExcelFileName = "C:\PictureTest.xlsx"
Dim Workbook As New Excel.Application
Dim DataWorkbook As New Excel.Workbook
Set DataWorkbook = Workbook.Workbooks.Open(ExcelFileName)
Workbook.Sheets("Sheet1").Cells(1, 1) = "Data to CELL"
DataWorkbook.Save
DataWorkbook.Close
Set Workbook = Nothing
Set DataWorkbook = Nothing
This one works perfectly, I can put data in any sheet anywhere I want.
However I also need to put pictures on certain sheets/cells.
I use the following code to add a picture to the active Excel file from which I am running the VBA script:
Dim PicturePath As String
PicturePath = "C:\Picture.tif"
Dim strPath As String
Dim Picture As Object
Set Picture = ActiveSheet.Pictures.Insert(PicturePath)
Picture.ShapeRange.LockAspectRatio = msoCTrue
Picture.Placement = xlMoveAndSize
Picture.ShapeRange.Width = 0.3 * Picture.Width
Is there anyone who can help me in getting both combined?
Related
I'm getting this error, "Microsoft Excel is waiting for another application to complete an OLE action" when trying to automate a PDF string search and record findings in excel. For certain PDFs this error is not popping. I assume this is due to the less optimized PDFs taking a longer time to search string while indexing page by page.
To be more precise, I have a workbook containing two sheets. One contains a list of PDF file names and the other has a list of words that I want to search. From the file list the macro would open each PDF file and take each word from the list of words and perform a string search. If found it would record each finding in a new sheet in the same workbook with the file name and the found string.
Below is the code I'm struggling with. Any help is welcome.
Public Sub SearchWords()
'variables
Dim ps As Range
Dim fs As Range
Dim PList As Range
Dim FList As Range
Dim PLRow As Long
Dim FLRow As Long
Dim Tracker As Worksheet
Dim gapp As Object
Dim gAvDoc As Object
Dim gPDFPath As String
Dim sText As String 'String to search for
FLRow = ActiveWorkbook.Sheets("List Files").Range("B1").End(xlDown).Row
PLRow = ActiveWorkbook.Sheets("Prohibited Words").Range("A1").End(xlDown).Row
Set PList = ActiveWorkbook.Sheets("Prohibited Words").Range("A2:A" & PLRow)
Set FList = ActiveWorkbook.Sheets("List Files").Range("B2:B" & FLRow)
Set Tracker = ActiveWorkbook.Sheets("Tracker")
'For each PDF file list in Excel Range
For Each fs In FList
'Initialize Acrobat by creating App object
Set gapp = CreateObject("AcroExch.App")
'Set AVDoc object
Set gAvDoc = CreateObject("AcroExch.AVDoc")
'Set PDF file path to open in PDF
gPDFPath = fs.Cells.Value
' open the PDF
If gAvDoc.Open(gPDFPath, "") = True Then
'Bring the PDF to front
gAvDoc.BringToFront
'For each word list in the range
For Each ps In PList
'Assign String to search
sText = ps.Cells.Value
'This is where the error is appearing
If gAvDoc.FindText(sText, False, True, False) = True Then
'Record findings
Tracker.Range("A1").End(xlDown).Offset(1, 0) = fs.Cells.Offset(0, -1).Value
Tracker.Range("B1").End(xlDown).Offset(1, 0) = ps.Cells.Value
End If
Next
End If
'Message to display once the search is over for a particular PDF
MsgBox (fs.Cells.Offset(0, -1).Value & " assignment complete")
Next
gAvDoc.Close True
gapp.Exit
set gAVDoc = Nothing
set gapp = Nothing
End Sub
I have now found the answer to this problem.
I'm using Acrobat Pro and whenever I open a PDF file, it opens with limited features due to Protected View settings. If I disable this function or if I click Enable All Features and save changes to the PDF files, VBA macro runs smooth.
It's funny, I'm posting an answer to my own problem.
I want to hide a column while exporting from datatable to excel. Here is my code
`Dim xapp As Application
Dim xWb As Workbook
fileName = System.IO.Path.GetTempFileName & ".xls"
fileName = fileName.Replace(".tmp", "")
xapp = New Application()
xWb = xapp.Workbooks.Open(fileName)
xWb.Sheets(2).Columns("I:I").EntireColumn.Hidden = True`
Even though I mention the code to hide the column, still it is appearing in the excel while execution. Please help me.
Thanks in advance
I have been searching for some time on how exactly to go about this, but I keep coming up with a large number of possible ways that come close, but never really give me exactly the sort of thing I'm looking for. The concept is pretty simple I need to open a certian .xls file using some VBA code in Access 2010. Once the file is opened I need to insert data and do some things to the file then save the file as a different filename and close the file. I also need it to close excel if it was not already open and if it was open I need it to leave excel alone and not save/close anything other than the template.xls file I am working with. I currently have code that will do part of this provided Excel is not already open at the time the script runs. When excel is already opened I get the following error;
"Run-time'91': Object variable or With block variable not set."
When I click debug I get the following line highlighted
x.ActiveWorkbook.SaveAs fileName:=savedfilename
Here is the code without all the junk that doesn't relate to the issue. I have cobbled together using examples from various sites.
Dim DateSampled As String
Dim strPath As String
Dim TemplatePath As String
Dim x As Excel.Application
Dim xBook As Excel.Workbook
Dim xSheet As Excel.Worksheet
DateAsString = Format(DateSampled, "MMDDYYYY")
savedfilename = strPath & "\" & TrainNum & "-" & DateAsString & ".xls"
TemplatePath = "B:\template.xls"
Set x = CreateObject("Excel.Application")
x.Visible = False
Set xBook = GetObject(TemplatePath)
xBook.Windows(1).Visible = True
Set xSheet = xBook.Worksheets(1)
'---------------CODE DOES STUFF WITH THE FILE -----------------------
x.DisplayAlerts = False
x.ActiveWorkbook.SaveAs fileName:=savedfilename
x.DisplayAlerts = True
x.ActiveWorkbook.Close
Set x = Nothing
Set xBook = Nothing
Set xSheet = Nothing
How can I get the saved file path from an Excel.Application object after showing the object and giving the user control?
I don't know that it's important, but I need this information because I want to write this path to registry so the app knows where to go for searching or future editing. If the file does not exist or my program has no location provided, then I want to start creating one with the default headings and allow them to edit and save as with excel.
The main function of the program is to read the excel file for search values and populate form controls. This feature is file maintenance / error handling.
My current code:
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim misVal As Object = Reflection.Missing.Value
Here I tried to make the user save the file somewhere before editing, but excel still asks them to save as when closing.
xlApp = New Excel.Application
Dim file As String = xlApp.GetSaveAsFilename()
xlApp = New Excel.Application(file)
Showing the workbook works fine, I'm just stuck on how to retrieve the path the user saved to after they close the showing interface.
xlBook = xlApp.Workbooks.Add(misVal)
xlSheet = xlBook.Sheets("sheet1")
xlSheet.Cells(1, 1) = "Group #"
xlApp.DefaultSaveFormat = Excel.XlFileFormat.xlExcel12
xlApp.UserControl = True
xlApp.Visible = True
Thanks, Boom
EDIT:
Henderso's answer is basically what I ended up doing.
xlApp = New Excel.Application
Dim file As String = xlApp.GetSaveAsFilename()
' make changes to the book
xlBook.SaveAs(file)
xlApp = New Excel.Application(file)
After this I kept getting the prompt from excel to save as when the user closed the window. using xlBook.Saved = True fixed this. I wanted the user to select a location for the file to be and then have the program "auto save" when closing so I needed to also add an event handler
AddHandler xlBook.BeforeClose, AddressOf auto_save
where auto_save is the name of a sub I defined to do the work of the handler xlBook.save().
This code will create a new book, and prompt for new file name. To the user, they will first get the save as prompt, then the new WB is shown. Flname contains the full path of the save as file:
Set NewWkbk = Workbooks.Add
Flname = Application.GetSaveAsFilename(InitialFileName:="", FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Enter Path for new file..")
NewWkbk.SaveAs (Flname)
Note, the GetSaveAsFilename filter is specifying .xlsx filetype. You may need to adjust this is you want .xls or .xlsm
There are a number of similar posts but nothing that does exactly what I want as simply as it needs to be for me to understand
I want to use Access 2007 VBA to open a csv file and replace the column headings row ie:
OldColumn1,OldColumn2
1,2
with
NewColumn1,NewColumn2
1,2
ie without disturbing the rump of data.
Then save and close.
I have tried this code, but it deletes my data:
Sub WriteFile()
Dim OutputFileNum As Integer
Dim PathName As String
PathName = Application.ActiveWorkbook.Path
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, "NewCol1" & "," & "NewCol2"
Close OutputFileNum
End Sub
Import or link to the .csv so that you have the recordset in your Access 2007 databases.
Write a query with NewColumn[x] as an alias for OldColumn[x].
Write vba code to use TransferText functionality or make a macro to do the same to export your query as a .csv file (overwriting the original csv if you want/need).
Obviously, there are plenty of bonus things you could do to automate and reproduce this concept for any number or types of files. But the above solution should work in an all MS Access environment.
Let me know if you would like details on any of these steps.
Further to my earlier comment, please see the method which uses the Excel reference:
Public Sub EditCsv()
Dim xlApp As Object
dim xlWbk As Object
Dim xlWst As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open ".../Test.csv" 'Amend this to your needs
Set xlWst = xlWbk.Sheets(1)
'This assumes the columns are at the beginning of the file
xlWst.Range("A1") = "My New Column Name"
xlWst.Range("B1") = "My New Second Column Name"
xlWbk.Close -1 'Close and save the file here
xlApp.Quit
Set xlApp = Nothing
Set xlWbk = Nothing
Set xlWst = Nothing
End Sub