I am trying to create a button which prompts the user for a file then creates a hyperlink in the active spreadsheet.
Goal: after the file is uploaded subsequent users can click on the hyperlink to view the file.
What I have tried, create an ActiveX control in Excel, but representing the input as a hyperlink output in a cell is the problem.
Private Sub CommandButton1_Click()
Dim sFullName As String
Application.FileDialog(msoFileDialogOpen).Show
sFullName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
End Sub
Insert reference to pdfs
Sub InsertObjectAsIcon()
'lets user browse for a file to insert into the
'current active worksheet.
'all are inserted as icons, not "visible" objects, so
'to view they will need an appropriate viewer/reader
'at the recipient end.
'
'This one shows how you could set up to use
'several different icons depending on the type of file
'inserted. You'll have to experiment by recording
'macros while inserting various file types to build
'up a list to use, just add new Case Is = statements
'do deal with the file types. Be sure to enter the
'file type in all UPPERCASE.
'
Dim iconToUse As String
Dim fullFileName As String
Dim FNExtension As String
fullFileName = Application.GetOpenFilename("*.*, All Files", , , , False)
If fullFileName = "False" Then
Exit Sub ' user cancelled
End If
'choose an icon based on filename extension
'get all after last "." in filename
FNExtension = Right(fullFileName, Len(fullFileName) - _
InStrRev(fullFileName, "."))
'select icon based on filename extension
Select Case UCase(FNExtension)
Case Is = "TXT"
iconToUse = "C:\Windows\system32\packager.dll"
Case Is = "XLS", "XLSM", "XLSX"
iconToUse = "C:\Windows\Installer\{91140000-0011-0000-0000-0000000FF1CE}\xlicons.exe"
Case Is = "PDF"
iconToUse = "C:\Windows\Installer\{AC76BA86-1033-F400-7761-000000000004}\_PDFFile.ico"
Case Else
'this is a generic icon
iconToUse = "C:\Windows\system32\packager.dll"
End Select
ActiveSheet.OLEObjects.Add(Filename:=fullFileName, Link:=False, DisplayAsIcon:=True, IconFileName:=iconToUse, IconIndex:=0, IconLabel:=fullFileName).Select3
End Sub
Private Sub CommandButton1_Click()
InsertObjectAsIcon
End Sub
This code opens the common file dialog, filtered to show .xslx files. It picks up the path to the file, then inserts it into the activecell. There's also an inputbox asking for a short text name, if you don't want to see the full path.
Sub FileToLink()
Dim strFileName As String
Dim strShortName As String
strFileName = Application.GetOpenFilename("Excel Documents (*.xlsx), *.xlsx")
If strFileName = "False" Then
Exit Sub ' user cancelled
End If
strShortName = InputBox("What do you want to call this link?", "Short Text", strFileName)
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strFileName, TextToDisplay:=strShortName
End Sub
You can substitute strFileName = Application.GetOpenFilename("All Documents (*.*), *.*") to show all files. It doesn't matter to the link what file it is, as clicking on the link will invoke the application linked with that file type.
Related
I got WB with different number of sheets and with the same structure and so on. There is one field let's say D8 as an example where is written number 3 (CH) and based on that number in that cell, I would like to export exactly that number of sheets into one PDF. So, if it is written five, then five pages into one PDF...or if it is one then one page in PDF.
That cell in D8 will be always on the same position, but the number might differ. Can this be somehow written into the code to look on this number and to export that many sheets into one PDF?
And I would like to have an option where to save every new PDF, not like now that is automatically created, firstly folder and then file.
Here is SS of my WB:
and this is piece of code what I was using but just to save sheets into single PDF, I am not so good in VBA so any help will be great!
Sub ExportAsPDF()
Dim FolderPath As String
FolderPath = "C:\Users\XYZ\Desktop\PDFs"
MkDir FolderPath
Sheets(Array("CH1", "CH2", "CH3")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & "\PDf", _
openafterpublish:=False, ignoreprintareas:=False
MsgBox "All PDF's have been exported!"
End Sub
When you ask a question, it is recommended to frequently check it and try clarifying the comments asking for clarifications...
If I understood well your question, please test the next code. It assumes that the answer to my suppositions in the comment is yes. The code offers a browse window to select the folder where to export the chosen (sheetsNo) number of sheets:
Sub ExportAsPDF()
Dim FolderPath As String, sheetsNo As Long, sh As Worksheet, arrSheets
Dim fldr As FileDialog, sItem As String, fileName As String, i As Long
sheetsNo = ActiveCell.value 'use there the sheet you need
ReDim arrSheets(sheetsNo - 1) 'redim the array to keep the sheets
'use a dialog to select the folder to export
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder where to export the pdf file"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
If sItem = "" Then Exit Sub 'if no folder selected the code stops
FolderPath = sItem
fileName = Replace(ThisWorkbook.Name, ".xlsm", ".pdf") 'use the workbook name, but changing its extension
For i = 1 To sheetsNo
arrSheets(i - 1) = Worksheets(i).Name 'put the sheets in an array
Next
Sheets(arrSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=FolderPath & "/" & fileName, _
openafterpublish:=False, ignoreprintareas:=False
MsgBox "All PDF's have been exported!"
End Sub
Please, test it and send some feedback.
I've developed a small ticketing system on excel VBA
The Save button will take all data from textboxes and radio button and add it to the row number 7 (in this case)
But when I press upload I can't add the link to the label of attachments
How to add link to the attachment label using (upload file ) button
And also save the Link value stored in upload file button to use it later in clear button and save button?
I'm confused to work with private sub and private dim variables.
I'm newbie in VBA please help
User Form of the System
Save Button Code
Upload button code
Public Sub btnAttachment_Click()
'To upload file link format is png, jpeg, PDF or All files'
Dim wks As Worksheet
Dim LinksList As Range
Dim lastRowLink As Long
Dim LinkAttached As Long
Set wks = ActiveSheet
Set LinksList = Range("N1")
'declare last row to insert link to
lastRowLink = WorksheetFunction.CountA(Sheets("Tickets").Range("A:A"))
Sheets("Tickets").Cells(lastRow + 1, 11).Value = LinkAttached
ChDrive "C:\"
ChDir "C:\"
Filt = "PNG Files(*.png),*.png ," & _
"Jpeg Files(*.jpeg),*.jpg ," & _
"PDF Files (*.pdf),*.pdf ," & _
"All Files (*.*),*.*"
FilterIndex = 1
Title = "Select a File to Hyperlink"
Filename = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Title)
If Filename <> False Then
wks.Hyperlinks.Add Anchor:=LinksList, _
Address:=Filename, _
TextToDisplay:=Filename
Else
MsgBox "No file was selected.", vbCritical, "Loading Error"
Exit Sub
End If
End Sub
Attachment PDF file link contains the code and photo too
Buttons Code link
EDIT:
I started a new workbook and tore down the original code to test in a fresh environment. None of the OLEObjects.add methods seem to work even in this sanitized environment. I'm beginning to think that this method and parameters fundamentally do something other than what I think they do based on their documentation. I've included the parsed down code below along with a picture of what attaching a .pdf file looks like.
Sub AttachDocument()
'create cell location string
Dim celllocation As String
celllocation = ("D6")
'Select the cell in which you want to place the attachment
Range(celllocation).Select
'Get file path
'fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
'If LCase(fpath) = "false" Then Exit Sub
fpath = "C:\Users\Username\Desktop\2019W2.pdf"
'Insert file
Worksheets("Sheet1").OLEObjects.Add Filename:=fpath, Link:=False, DisplayAsIcon:=True, IconFileName:="EXCEL.EXE"
End Sub
I just don't understand why the parameters do not work. Any help is appreciated.
Original Post:
I have code that adds an OLEObject to a worksheet at a specific cell. It works, but I cannot get the parameters for OLEObjects.add method to do anything. The only one that seems to work is "Filename". No matter how I define any of the other parameters the behavior of the macro does not change; I'm not even sure the "Linked" parameter is working and the icon is always dependent on the file type uploaded but does not behave as expected(e.g. word documents do not display word icon, instead a large blank/white square). Ultimately, I want to set the icon to a common icon and define its size. What am I doing wrong here?
Sub AttachDocument()
'Check to make sure there is a selection for table row, if not end macro, also check for selection greater than the number of rows in the table, if yes end macro
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("RenewablesTable")
If Range("M3").Value < 1 Then
ElseIf Range("M3").Value > tbl.DataBodyRange.Rows.Count Then
Else
'create cell location string
Dim cellnum As Integer, celllocation As String
cellnum = Range("M3").Value + 8
celllocation = ("M" & cellnum)
'Select the cell in which you want to place the attachment
Range(celllocation).Select
'check if cell already has an object if it does end macro
If CheckCellforObject(celllocation) > 0 Then
Else
'Get file path
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
If LCase(fpath) = "false" Then Exit Sub
'Insert file
Worksheets("Renewable Energy").Unprotect "password"
Worksheets("Renewable Energy").OLEObjects.Add Filename:=fpath, Link:=False, DisplayAsIcon:=True, IconFileName:="excel.exe"
Worksheets("Renewable Energy").Protect "password"
End If
End If
End Sub
I would like to insert an Excel document into an Excel worksheet. I can do this manually by the following steps;
Insert / Text / Object / Create From File (tick Display as Icon) / Browse.
I then select the file and insert the document.
I would like to do this via a macro. (The recorder won't let you record it.)
This code I have basically is Insert / Text / Object
Sub ShowInsertObj()
Application.Dialogs(xlDialogInsertObject).Show
End Sub
I would like to add code so that a directory (lets say C:\temp) will automatically be selected and display as icon will be ticked - instead of applying the above steps.
Not sure if exactly what you wanted is possible, but you might want to use GetOpenFilename and .OLEObjects instead of xlDialogInsertObject.
Sub ShowInsertObj()
Dim Fl As Variant
Dim Filename As String
'Set your drive
ChDrive "C:"
ChDir "C:\temp"
'Grab your file filtered for Excel files
Fl = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls; *.xlsm),*.xls;*.xslm")
If Fl = False Then Exit Sub
' To display the filename only and not the path
Filename = Mid$(F1, InStrRev(F1, "\") + 1, Len(F1))
'Add as object to the worksheet
Sheet1.OLEObjects.Add Filename:=Filename, Link:=True, DisplayAsIcon:=True, IconFileName:="EXCEL.EXE", IconIndex:=0, IconLabel:=Filename
End Sub
Note: I used FileFilter since you said you wanted to insert an Excel file
I am writing a macro in MS excel using VBA. I need to open or create a file to write to.
Potentially the file may have a different extension (i.e. .cal) but internally it just contains text.
I have looked over a lot of examples that create a file by explicitly stating the path for the new file (here's one I found):
strFileName = "C:\test.txt"
Open strFileName For Output As #iFileNumber
Other examples open a file which already exists.
I would like to have a popup/dialog which allows the user to "either" open an existing file "or" create a new one. I assume this is possible.
I have played around with the Application.FileDialog(....) function using strings/paths and objects without much success so far.
With Application.FileDialog(...) your user should be able to create a new text file as they would in Windows Explorer (by right-clicking and selecting New->Text File), they can then select that file to output data to.
The below SelectFile(...) function returns the path to a selected file (or an empty string if no file was selected). Using this function as-is it is only possible for the user to select one file, but given the context I would hope this isn't a problem.
Public Sub SelectOrCreateFile()
Dim strFileName As String
Dim iFileNum As Integer
iFileNum = FreeFile
strFileName = SelectFile
If strFileName <> "" Then
Open strFileName For Output As #iFileNum
'### WRITE YOUR DATA ###
Close #iFileNum
End If
End Sub
'Returns File Path of file selected with file selection dialog
Public Function SelectFile(Optional DefaultPath As String = "", _
Optional FileType As String = "All Files", _
Optional FileExtension As String = "*.*") As String
Dim F As Object
Set F = Application.FileDialog(msoFileDialogFilePicker)
'Set up FileDialog properties
F.Filters.Clear
F.Filters.Add FileType, FileExtension
F.AllowMultiSelect = False
F.Title = "Select File"
F.ButtonName = "Select"
If DefaultPath <> "" Then F.InitialFileName = DefaultPath
'FileDialog.Show returns False if the user cancels
If F.show Then
SelectFile = F.SelectedItems(1)
Else
MsgBox "No File Selected", vbInformation, "Cancelled"
SelectFile = ""
End If
Set F = Nothing
End Function
Hope this helps!