Anyone have a macro for this?

[Terry Pinnell]

It's been a long time since I wrote my last VBA macro, and I don't
want to duplicate one that might already exist. So before I get stuck
into it, does anyone have a macro that will do the following please:
- Start with a clip art picture selected (or inserted into a Word
document if that's easier).

- Finish with its file (WMF or GIF) copied into an Explorer/My
Computer folder please?

 

[Helmut Weber]

Hi Terry,

- Start with a clip art picture selected (or inserted into a Word
document if that's easier).

Inserted. Selected.
Copy the selection.
Create a new document.
Paste the selection.
Save the doc as *.htm
A new folder will be created,
the name of which is something like "Docname-files",
containing one gif, which is the gif you need.

But what would that be good for?

In the end, you do nothing but copy a clipart
from one folder to the other.
There are plenty of good tools to organize
pictures of any kind.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Terry Pinnell]

Hi Terry,

Inserted. Selected.
Copy the selection.
Create a new document.
Paste the selection.
Save the doc as *.htm
A new folder will be created,
the name of which is something like "Docname-files",
containing one gif, which is the gif you need.

But what would that be good for?

In the end, you do nothing but copy a clipart
from one folder to the other.
There are plenty of good tools to organize
pictures of any kind.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

Thanks, Helmut, but I'm afraid that doesn't do what I specified. It
creates an html document (Doc3.htm in this case) in a folder of my
choice, and places an image inside it. (BTW, on running the recorded
macro again from another selected and inserted clip, it replaces that
image with the second one, losing the first. So it's not even a
cumulative set.)

But anyway, it does not "Finish with its file (WMF or GIF) copied into
an Explorer/My Computer folder..."

To repeat: I want copies of the files (plural) representing all clip
art selections on which I've run the macro to finish up in a single
folder of my choice.

As for its potential usefulness, you are mistaken! There are some
17,000 files in the various folders and subfolders of MS Office Clip
Art. Their names are meaningless. And so far I have found no other
program that will open the MMC files containing collections of their
keywords and let me manipulate them. So, finding an image on a
particular topic is needle and haystack stuff! However, as you know,
they *can* be searched rapidly with Clip Gallery, or using the clip
art facilities of Word or Excel. Having found a set of hits, I then
want to operate as I described on them.

It's not relevant to the macro design, but for background: I would use
the resultant files for various subsequent purposes (teaching
related). I could for example create a folder called Sport and quickly
populate it with 20 or 30 pertinent clip art images.

 

[Helmut Weber]

Hi Terry,
I think, I see a bit clearer now.
How about renaming the one GIF or WMF
in the folder with the name of the doc
after having created the htm-file?

It creates an html document (Doc3.htm in this case) in a folder of my
choice, and places an image inside it. (BTW, on running the recorded
macro again from another selected and inserted clip, it replaces that
image with the second one, losing the first. So it's not even a
cumulative set.)

Giving it a new fullname on the same device would be
equal to copying it and deleting the source file.
With two small problems to be mastered, probably.
That is, waiting until the GIF split from the word-doc is available,
and creating a name that is different from any name of any GIF
in the target folder. Not too difficult, though.
The name of the GIF is always "image002.gif" here and now.
(I wonder why.) So, one way could be:
Save the doc as ....
To prevent endless new folders doc1, doc2, doc3.
But even that could be handled.
Save it as htm.
Close the htm.
Open the doc. Delete any shape or inlineshape, probably.
But again, that is not the problem.
Look, if the GIF is already there.
If not, wait. Look again.
If it is there, read the names of the GIFs
in the target folder into an sorted array.
Get the last entry in the array.
Insolate the number.
Increment the number.
Build a new filename using the incremented number for the GIF.
Rename the GIF.

If you need help on the details, ask again.

It sure can be done.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/






C

 

[Helmut Weber]

Hi Terry,

the following macro is a possible implementation,
only in principle, of course, as it causes an error,
e.g. if you run the macro and there is no image in the doc.

Sub Makro12()
Dim sFolder As String
Dim sNewnam As String
Dim sOldnam As String
Dim sExtens As String
ActiveDocument.SaveAs FileName:="c:\test\Gif.htm",
FileFormat:=wdFormatHTML
Selection.WholeStory
Selection.Delete
ActiveDocument.SaveAs FileName:="c:\test\Gif.doc",
FileFormat:=wdFormatDocument
sFolder = ActiveDocument.FullName
sFolder = Left(sFolder, Len(sFolder) - 4)
sFolder = sFolder & "-Dateien\" ' GERMAN VERSION
sOldnam = Dir(sFolder & "image002.???", vbNormal)
sExtens = Right(sOldnam, 4)
With Application.FileSearch
.LookIn = "c:\sport\"
.FileName = "image???.???"
.Execute SortBy:=msoSortByFileName
If .FoundFiles.Count > 0 Then
sNewnam = Right(.FoundFiles(.FoundFiles.Count), 12)
sNewnam = Mid(sNewnam, 6, 3)
sNewnam = Format(Val(sNewnam) + 1, "000")
sNewnam = "image" & sNewnam & sExtens
Name sFolder & sOldnam As "c:\sport\" & sNewnam
End If
End With
End Sub

And note that sFolder = sFolder & "-Dateien\"
is the German version.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Terry Pinnell]

Hi Terry,

the following macro is a possible implementation,
only in principle, of course, as it causes an error,
e.g. if you run the macro and there is no image in the doc.

Sub Makro12()
Dim sFolder As String
Dim sNewnam As String
Dim sOldnam As String
Dim sExtens As String
ActiveDocument.SaveAs FileName:="c:\test\Gif.htm",
FileFormat:=wdFormatHTML
Selection.WholeStory
Selection.Delete
ActiveDocument.SaveAs FileName:="c:\test\Gif.doc",
FileFormat:=wdFormatDocument
sFolder = ActiveDocument.FullName
sFolder = Left(sFolder, Len(sFolder) - 4)
sFolder = sFolder & "-Dateien\" ' GERMAN VERSION
sOldnam = Dir(sFolder & "image002.???", vbNormal)
sExtens = Right(sOldnam, 4)
With Application.FileSearch
.LookIn = "c:\sport\"
.FileName = "image???.???"
.Execute SortBy:=msoSortByFileName
If .FoundFiles.Count > 0 Then
sNewnam = Right(.FoundFiles(.FoundFiles.Count), 12)
sNewnam = Mid(sNewnam, 6, 3)
sNewnam = Format(Val(sNewnam) + 1, "000")
sNewnam = "image" & sNewnam & sExtens
Name sFolder & sOldnam As "c:\sport\" & sNewnam
End If
End With
End Sub

And note that sFolder = sFolder & "-Dateien\"
is the German version.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

Thanks very much, Helmut. I greatly appreciate your going to that
trouble.

I'm very rusty so I've probably done something wrong here. These are
the steps I took to try your macro:

1) Opened Word 2000 new document
2) Insert>Picture>Clipart, chose a clip, and inserted it
3) Closed the clip dialog, so now looking at picture of a horse, from
Animal section. Selected that.
4) Opened VBA Editor
5) Insert>Module, and pasted in your macro
6) Run (F5)
This is what I then saw displayed:
http://www.terrypin.dial.pipex.com/Images/HelmutMacroView1.gif

 

[Helmut Weber]

Hi Terry,

somehow a comma has managed to place itself
at the end of the line in question. ;-)
Make it go away!

Same with this line:
Maybe it's the same despicable comma again.

And be aware of this:
sFolder = sFolder & "-Dateien\" ' GERMAN VERSION
probably
sFolder = sFolder & "-files\"
in an english version.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Terry Pinnell]

Hi Terry,


somehow a comma has managed to place itself
at the end of the line in question. ;-)
Make it go away!

Same with this line:

Maybe it's the same despicable comma again.

And be aware of this:
sFolder = sFolder & "-Dateien\" ' GERMAN VERSION
probably
sFolder = sFolder & "-files\"
in an english version.

Thanks Helmut. With those 3 changes made I got one line further!
Maybe I should have mentioned that these two lines:
FileFormat:=wdFormatHTML
FileFormat:=wdFormatDocument
are red, which I think means there is something wrong with the syntax,
yes?

For convenience, here is the code I am using:

Sub Makro12()
Dim sFolder As String
Dim sNewnam As String
Dim sOldnam As String
Dim sExtens As String
ActiveDocument.SaveAs FileName:="c:\test\Gif.htm"
FileFormat:=wdFormatHTML
Selection.WholeStory
Selection.Delete
ActiveDocument.SaveAs FileName:="c:\test\Gif.doc"
FileFormat:=wdFormatDocument
sFolder = ActiveDocument.FullName
sFolder = Left(sFolder, Len(sFolder) - 4)
sFolder = sFolder & "-files\"
sOldnam = Dir(sFolder & "image002.???", vbNormal)
sExtens = Right(sOldnam, 4)
With Application.FileSearch
.LookIn = "c:\sport\"
.FileName = "image???.???"
.Execute SortBy:=msoSortByFileName
If .FoundFiles.Count > 0 Then
sNewnam = Right(.FoundFiles(.FoundFiles.Count), 12)
sNewnam = Mid(sNewnam, 6, 3)
sNewnam = Format(Val(sNewnam) + 1, "000")
sNewnam = "image" & sNewnam & sExtens
Name sFolder & sOldnam As "c:\sport\" & sNewnam
End If
End With
End Sub

 

[Helmut Weber]

Hi Terry,
it is the line breaks of the news reader, that cause confusion.
E.g.
ActiveDocument.SaveAs FileName:="c:\test\Gif.htm", _
FileFormat:=wdFormatHTML

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Helmut Weber]

which means, that my first hint on just
removings the commas was wrong.
Sorry for that.