I have a button and a textbox and I want to make the button to open the folder by a default path.
I will give example:
'C:\Folder\...
Dim path as string
path = "C:\Folder\.."
Dim fso
set fso = createobject("Scripting FileSystemObjh)
I tried some method where it only opens the folder but doesn't get the file path so not what I want to do.
And when I select the file and click okay the file path to be printed on the textbox.
Thank you in advance!
If I understand what you need, the following should point you in the right direction. First, select the following Component:
Microsoft Common Dialog Control 6.0 (SP6)
Second, select the following Reference:
Microsoft Scripting Runtime
Third, drop a CommonDialog control onto your form along with the CommandButton and TextBox. Type the following code:
Option Explicit
Private Sub Command1_Click()
Dim fso As FileSystemObject
Dim path As String
path = "c:\temp\"
CommonDialog1.InitDir = path
CommonDialog1.Filter = "Text Files (*.txt)|*.txt|All files (*.*)|*.*"
CommonDialog1.DefaultExt = "txt"
CommonDialog1.DialogTitle = "Select File"
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
Set fso = New FileSystemObject
'use fso to do whatever you need
End Sub
Related
My goal of this program is to open a picture in a folder by selecting a cells value in the active row which im using the line to do.
picture = Cells(ActiveRow, 6).Value
I am getting a Run time error '1004' Application-defined or object defined error
Here is my full code
Sub Picture_Click()
Sheets("Master").Unprotect Password:="Conti1"
Sheets("Records").Unprotect Password:="Conti1"
Dim picture As String
Dim ActiveRow As Long
Worksheets("Master").Activate
ActiveRow = Rows(ActiveCell.Row).Select
picture = Cells(ActiveRow, 6).Value
ChDir"P:\926_TM\03_LocalExchange\Tracking_and_Labeling\LabEquipment\pictures"
Workbooks.Open picture
End Sub
I am trying to use the value from the selected cell to be the name of the picture file in the selected folder, the picture I would like to open.
also I am getting a value of -1 for ActiveRow
Any help would be great!
You can't open a picture with the Workbooks.Open method, as that method is exclusively for opening workbooks.
One option is to use a Shell command to open the picture. In this example, I will open a picture located on the the Pictures folder named Test.png
Private Sub OpenPic()
Shell "mspaint.exe C:\Users\USERNAME\Pictures\Test.png"
End Sub
This will open the picture in paint.
Adapting this method to your code:
Sub Picture_Click()
Sheets("Master").Unprotect Password:="Conti1"
Sheets("Records").Unprotect Password:="Conti1"
Dim picture As String
Dim ActiveRow As Long
Worksheets("Master").Activate
ActiveRow = ActiveCell.Row
picture = Cells(ActiveRow, 6).Value
Shell "mspaint.exe P:\926_TM\03_LocalExchange\Tracking_and_Labeling\LabEquipment\pictures\" & picture
End Sub
This assumes that the value in Activerow, 6 includes the file extension.
As an aside: I would add that you don't need to define ActiveRow at all and could just use it as-is.
So this:
ActiveRow = ActiveCell.Row
picture = Cells(ActiveRow, 6).Value
Can be rewritten as:
picture = Cells(ActiveCell.Row, 6).Value
And you can omit the ActiveRow variable altogether.
ActiveRow is a Long, so you cannot select a row and say that is a number. You would simply write
ActiveRow = ActiveCell.Row
In the immediate window, if you write ?Rows(ActiveCell.Row).Select, it will return a Boolean Value, not a number.
Also to open a file you should use the FollowHyperlink method:
from msdn:
ActiveWorkbook.FollowHyperlink Address:="http://example.microsoft.com"
Your link would replace the one in the example of course.
picture = "P:\926_TM\03_LocalExchange\Tracking_and_Labeling\LabEquipment\pictures\" & Cells(ActiveRow, 6).Value
ActiveWorkbook.FollowHyperlink Address:=picture
This answer will help you to open in default photo viewer.
I tried,
Sub image_opener()
Dim photo_path As String
photo_path = Worksheets("Sheet1").Range(Selection.Address).Value
PID = Shell(photo_path, vbNormalFocus)
End Sub
but the above code didn't work for me. I think the McAfee in my PC is preventing the excel from running that shell command.
So, I created a openImg.bat file containing
%1
%1 basically takes the input from the user.
Normally we can open image using this openImg.bat by,
openImg.bat path_of_image/image.jpg
So, I edited the VBA accordingly
Sub image_opener()
Dim photo_path As String
photo_path = Worksheets("Sheet1").Range(Selection.Address).Value
PID = Shell("bat_file_path\openImg.bat " & photo_path, vbNormalFocus)
End Sub
photo_path = "image_path/image.jpg" . Finally I setup a shortcut key for the macro from Developer>Macros>Options>Shortcut Key .
The above worked for me.
I have approx. 100 images , I want to read those images, do the resizing and save it in a power point using matlab, Is it way to save those images in a power point giving title to each slide.
I am reading images using this code:
for i = 1:numel(pngfiles)
im{i} = imread(pngfiles{i});
imrgb{i} = rgb2gray(im{i});
imrgb_z{i} = imrgb{i}(160:350,280:450);
end
It seems to me that the best approach would be to use a VBA script inside Powerpoint, rather than manipulating ppt from Matlab. The steps would be
Create your list of images in a folder - using a sensible naming scheme
Open Powerpoint; go to the VBA editor (Alt-F11) and add a module with the following lines of code in it (note - this is taken straight from https://stackoverflow.com/a/5038907/1967396 with minimal edits):
-
Sub CreatePictureSlideshow( )
Dim presentation
Dim layout
Dim slide
Dim FSO
Dim folder
Dim file
Dim folderName
Dim fileType
' Set this to point at the folder you wish to import JPGs from
' Note: make sure this ends with a backslash \
fileType = ".jpg" ' <<< change this to the type you want
folderName = "c:\somedirectory\" ' <<< change this to the directory you want
' setup variables
Set presentation = Application.ActivePresentation
' choose the layout you want: e.g. if the title needs a particular format
Set layout = Application.ActivePresentation.SlideMaster.CustomLayouts(1)
Set FSO = CreateObject("Scripting.FileSystemObject")
' Retrieve the folder's file listing and process each file
Set folder = FSO.GetFolder(folderName)
For Each file In folder.Files
' Filter to only process JPG images
If LCase(Right(file.Name), 4)) = fileType Then
' Create the new slide and delete any pre-existing contents
Set slide = presentation.Slides.AddSlide(presentation.Slides.count + 1, layout)
While slide.Shapes.count > 0
slide.Shapes(1).Delete ' <<< You might not want to do this is you want to keep the title placeholder
Wend
' Add the picture
slide.Shapes.AddPicture folderName + file.Name, False, True, 10, 10
' Optional: create a textbox with the filename on the slide for reference
' alternatively, add text to the title shape
Dim textBox
Set textBox = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 200, 200)
textBox.TextFrame.TextRange.Text = file.Name ' <<< or whatever "title" you wanted
End If
Next
End Sub
You can modify this further to get the title in the format you want, etc.
you could try this:
Is there an example of using MATLAB to create PowerPoint slides?
For example:
% before the following, you have to create the ppt as explained, see link above!
% I prefer using some name instead of i or j
for img_ind = 1:numel(pngfiles)
% this depends on the ppt-version (see link above)-> here for 2007 and higher
mySlide = Presentation.Slides.Add(1,'ppLayoutBlank')
% Note: Change the image file full path names to where you save them
Image1 = mySlide.Shapes.AddPicture('<full path>\name_of_image(img_ind).png','msoFalse','msoTrue',100,20,500,500)
end
% then you have to save it, see link above!
In your case, I guess you have to save the image first as shown in the example:
print('-dpng','-r150','<full path>\test1.png')
edit
This will only work when using Matlab on Windows, because COM is needed. See comments on Floris answer!
Coming late to this party: Here's a "Matlab Pick of the Week" tool:
http://www.mathworks.com/matlabcentral/fileexchange/30124-smart-powerpoint-exporter
Take note of some of the comments at that page, as apparently the tool has not been updated in a few years.
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.
I'm trying to create a toolbar with a button that will change the LanguageID for all shapes and text boxes in a PowerPoint document to EnglishUS. This is to fix a problem where if someone spell-checks a document using another language (in this instance, French), that language is embedded into the .ppt file itself. When another user tries to spell-check the same area using another language, say English, the words the spell checker suggests are in the original language. For instance, it tried to correct the word 'specified' to 'specifie', a French word. From what I've read, the only way to fix this language issue is with a VBscript, and the only way to run a VBscript in Powerpoint without embedding it into a .ppt and loading that file every time is by creating an add-in with a toolbar button to run the macro, also using VBS. Below is the code which I've taken from various sources, and when I tried to put it together, it didn't work (although it did compile). If someone could take a look, I'm sure its a simple syntax error or something like that, it would be a HUGE help. Thanks in advance!!
By the way if anyone knows an easier way to run a macro in PPT without having to open a certain PPT every time, I'm ALL ears.
and now, the script:
Sub Auto_Open()
Dim oToolbar As CommandBar
Dim oButton As CommandBarButton
Dim MyToolbar As String
''# Give the toolbar a name
MyToolbar = "Fix Language"
On Error Resume Next
''# so that it doesn't stop on the next line if the toolbar's already there
''# Create the toolbar; PowerPoint will error if it already exists
Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
Position:=msoBarFloating, Temporary:=True)
If Err.Number <> 0 Then
''# The toolbar's already there, so we have nothing to do
Exit Sub
End If
On Error GoTo ErrorHandler
''# Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)
''# And set some of the button's properties
With oButton
.DescriptionText = "Fix Language for Spell Check"
''# Tooltip text when mouse if placed over button
.Caption = "Click to Run Script"
''# Text if Text in Icon is chosen
.OnAction = "Button1"
''# Runs the Sub Button1() code when clicked
.Style = msoButtonIcon
''# Button displays as icon, not text or both
.FaceId = 59
End With
''# Repeat the above for as many more buttons as you need to add
''# Be sure to change the .OnAction property at least for each new button
''# You can set the toolbar position and visibility here if you like
''# By default, it'll be visible when created
oToolbar.Top = 150
oToolbar.Left = 150
oToolbar.Visible = True
NormalExit:
Exit Sub ''# so it doesn't go on to run the errorhandler code
ErrorHandler:
''# Just in case there is an error
MsgBox Err.Number & vbCrLf & Err.Description
Resume NormalExit:
End Sub
Sub Button1()
''# This is the code to replace the LanguageID throughout the ppt
Option Explicit
Public Sub ChangeSpellCheckingLanguage()
Dim j As Integer, k As Integer, scount As Integer, fcount As Integer
scount = ActivePresentation.Slides.Count
For j = 1 To scount
fcount = ActivePresentation.Slides(j).Shapes.Count
For k = 1 To fcount
If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).Shapes(k) _
.TextFrame.TextRange.LanguageID = msoLanguageIDEnglishUS
End If
Next k
Next j
End Sub
End Sub
The answer is quite obvious if it is not clear yet.
As you can see the sub Button1() encapsulates another sub. Thus, I advise you to remove the call ChangeSpellingCheckingLanguage and the last End sub, then your code will work.
This may be an incredibly late answer, but I just solved this problem using VBScript (which can be run outside of powerpoint). The script as written will change the language of each powerpoint file in a given directory (and subdirectories) to English. Here's the script:
Option Explicit
'microsoft office constants
Const msoTrue = -1
Const msoFalse = 0
Const msoLanguageIDEnglishUS = 1033
Const msoGroup = 6
'starting folder (current folder)
Const START_FOLDER = ".\"
'valid powerpoint file extensions
Dim FILE_EXTENSIONS : FILE_EXTENSIONS = Array("pptx", "pptm", "ppt", "potx", "potm", "pot")
'desired language for all Text
Dim DESIRED_LANGUAGE : DESIRED_LANGUAGE = msoLanguageIDEnglishUS
'VBScript file system objects for starting folder
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartingFolder : Set objStartingFolder = objFSO.GetFolder(START_FOLDER)
IterateContainingItems objStartingFolder
'recursive subroutine to iterate each file in specified folder and all subfolders
Sub IterateContainingItems(objCurrentFolder)
Dim colFiles : Set colFiles = objCurrentFolder.Files
Dim objCurrentFile
For Each objCurrentFile in colFiles
ReportInfo(objCurrentFile)
Next
Dim colFolders : Set colFolders = objCurrentFolder.SubFolders
Dim objNextFolder
For Each objNextFolder in colFolders
IterateContainingItems objNextFolder
Next
End Sub
'subroutine executed for every file iterated by IterateContainingItems subroutine
Sub ReportInfo(objCurrentFile)
Dim strPathToFile
strPathToFile = objFSO.GetAbsolutePathName(objCurrentFile.Path)
If isPowerpointFile(strPathToFile) Then
Dim objPowerpointApp, objPresentations, objPresentation, objSlides, intSlideCount
set objPowerpointApp = CreateObject("Powerpoint.Application")
set objPresentations = objPowerpointApp.Presentations
Set objPresentation = objPresentations.Open(strPathToFile, msoFalse, msoFalse, msoFalse)
Set objSlides = objPresentation.Slides
intSlideCount = objSlides.Count
ResetLanguage objPresentation
objPresentation.Save
objPresentation.Close
objPowerpointApp.Quit
End If
End Sub
'check if given filepath specifies a powerpoint file as described by the "constant" extension array
Function isPowerpointFile(strFilePath)
Dim strExtension, found, i
strExtension = objFSO.GetExtensionName(strFilePath)
found = false
for i = 0 to ubound(FILE_EXTENSIONS)
if FILE_EXTENSIONS(i) = strExtension then
found = true
exit for
end if
next
isPowerpointFile = found
End Function
'finds every shape in the entire document and attempts to reset its LanguageID
Sub ResetLanguage(objCurrentPresentation)
Dim objShape
'change shapes from presentation-wide masters
If objCurrentPresentation.HasHandoutMaster Then
For Each objShape in objCurrentPresentation.HandoutMaster.Shapes
ChangeLanguage objShape
Next
End If
If objCurrentPresentation.HasNotesMaster Then
For Each objShape in objCurrentPresentation.NotesMaster.Shapes
ChangeLanguage objShape
Next
End If
If objCurrentPresentation.HasTitleMaster = msoTrue Then
For Each objShape in objCurrentPresentation.TitleMaster.Shapes
ChangeLanguage objShape
Next
End If
'change shapes from each design's master
Dim tempDesign
For Each tempDesign in objCurrentPresentation.Designs
For Each objShape in tempDesign.SlideMaster.Shapes
ChangeLanguage objShape
Next
Next
'change shapes from each slide
Dim tempSlide
For Each tempSlide in objCurrentPresentation.Slides
For Each objShape in tempSlide.Shapes
ChangeLanguage objShape
Next
If tempSlide.hasNotesPage Then
For Each objShape in tempSlide.NotesPage.Shapes
ChangeLanguage objShape
Next
End If
Next
End Sub
'if the given shape contains a text element, it checks and corrects the LanguageID
'if the given shape is a group, it iterates through each element in the group
Sub ChangeLanguage(objShape)
If objShape.Type = msoGroup Then
Dim objShapeGroup : Set objShapeGroup = objShape.GroupItems
Dim objShapeChild
For Each objShapeChild in objShapeGroup
ChangeLanguage objShapeChild
Next
Else
If objShape.HasTextFrame Then
Dim intOrigLanguage : intOrigLanguage = objShape.TextFrame.TextRange.LanguageID
If Not intOrigLanguage = DESIRED_LANGUAGE Then
If objShape.TextFrame.TextRange.Length = 0 Then
objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]"
End If
objShape.TextFrame.TextRange.LanguageID = DESIRED_LANGUAGE
If objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]" Then
objShape.TextFrame.TextRange.Text = ""
End If
End If
End If
End If
End Sub
To run it, just copy and paste the code into a text editor and save it as "script_name.vbs" in the directory with your powerpoint files. Run it by double clicking the script and waiting.
To load a macro every time PowerPoint is opened, you will want to create a PowerPoint AddIn. Microsoft has provided step-by-step guide for Office XP. For Office 2007 and newer, AFAIK the following steps will do that:
Save file as *.ppam into the directory it suggests (%APPDATA%\Microsoft\AddIns)
Open the Settings (click the office button in the top left corner and select "PowerPoint Options"), select the "Add-Ins" page, choose "PowerPoint Add-Ins" in the drop-down behind "Manage" and click the "Go" button. A dialog opens. Selecting "Add New" brings up a file picker dialog. You should be able to select the file there.
You can also use the Office Custom UI Editor to create ribbons.
However, I have already created such a Language Fixer Add-In for current versions of PowerPoint, and I have put it up for free download for personal use: PowerPoint Language Fixer by Jan Schejbal
I realize that I may be being a bit lazy, but does anyone know of a Visual Studio macro, where I can select some text inside of the Visual Studio IDE, click a button, and have it wrap the selected text with tags? It would generate something like:
<strong>My Selected Text</strong>
I would even be up for creating a macro, just not sure where to exactly start!
The code to do so is rather simple:
Sub SurroundWithStrongTag()
DTE.ActiveDocument.Selection.Text = "<strong>" + DTE.ActiveDocument.Selection.Text + "</strong>"
End Sub
Now, if you don't know much about macros here's how to add it:
First you need open the macros IDE, click Tools->Macros->Macros IDE...
Next, we will add a module for your custom macros. Right click on "MyMacros" in the Project Explorer, click Add->Add Module..., type in an appropriate name then click "Add".
Now paste the function inside the module, making copies for any other tags you want
Save and close the macros IDE
To hook the macro up to a button:
Click Tools->Customize...
Click New..., type in an appropriate name, click OK. An empty toolbar should be visible (you may have to move the window to see it)
Click the Commands tab, and select "Macros" in categories
Find the macros created before and drag them over to the toolbar
Right click the buttons to change settings (such as displaying an icon instead of text)
I know this is an old topic, but maybe someone finds this useful.
I have the following set up:
Sub WrapInH1()
WrapInTag("h1")
End Sub
Sub WrapInP()
WrapInTag("p")
End Sub
Sub WrapInStrong()
WrapInTag("strong")
End Sub
Sub WrapInTag()
WrapInTag("")
End Sub
Sub WrapInTag(ByVal tagText As String)
EnableAutoComplete(False)
If tagText.Length = 0 Then
tagText = InputBox("Enter Tag")
End If
Dim text As String
text = DTE.ActiveDocument.Selection.Text
text = Regex.Replace(text, vbCrLf & "$", "") 'Remove the vbCrLf at the end of the line, for when you select the line by clicking in the margin, otherwise your closing tag ends up on it's own line at the end...
DTE.ActiveDocument.Selection.Text = "<" & tagText & ">" & text & "</" & tagText & ">" & vbCrLf
EnableAutoComplete(True)
End Sub
Private Sub EnableAutoComplete(ByVal enabled As Boolean)
Dim HTMLprops As Properties
Dim aProp As EnvDTE.Property
HTMLprops = DTE.Properties("Texteditor", "HTML Specific")
aProp = HTMLprops.Item("AutoInsertCloseTag")
aProp.Value = enabled
End Sub
Dim HTMLprops As Properties = DTE.Properties("Texteditor", "HTML Specific")
Dim aProp As EnvDTE.Property = HTMLprops.Item("AutoInsertCloseTag")
aProp.Value = False
Original answer
If you want an out of the box solution, Visual Studio 2015 comes with a new shortcut, Shift+Alt+W wraps the current selection with a div. This shortcut leaves the text "div" selected, making it seamlessly changeable to any desired tag. This coupled with the automatic end tag replacement makes for a quick solution.
Example
Shift+Alt+W > strong > Enter