VBA and Powerpoint.

This application will take a selected directory of drawings, convert them to WMF format and insert them into Powerpoint as individual slide.

Usage :

Open the Powerpoint file dwg2slide.ppt.
Run the macro 'dwg2slide'.
Choose any file in the directory you wish to process.
Select 'O.K.' to proceed and sit back.
After a couple of minutes (depending on how many drawing files are in
the directory you choose), your slides will have been created. 

First create a module named Module1: 

Public dirname As String

Sub Dwg2Slide()
Dim selname As String
Dim SelName1 As String
Dim InCounter As Integer
Dim InFoundpos As Integer


UserForm1.CommonDialog1.Filter = "dwg Files (*.dwg)|*.dwg"
'set default file type

UserForm1.CommonDialog1.Flags = cdlOFNHideReadOnly
'switch off read only

UserForm1.CommonDialog1.ShowOpen
'open dialog box

selname = UserForm1.CommonDialog1.filename
'retrieve the file name

InCounter = 1
'initilize counter

InFoundpos = InStr(InCounter, selname, "\")
'look for the \
While InFoundpos <> 0
'check for the last \

    SelName1 = Mid$(selname, InCounter, InFoundpos - InCounter)
    'extract the directory name
    
            InCounter = InFoundpos + 1
            'increase the counter
            
            InFoundpos = InStr(InCounter, selname, "\")
            'find the next \
            
    dirname = dirname & SelName1 & "\"
    'construct the path
    
Wend

UserForm1.Show
'show the dialog

End Sub

Private Sub CommandButton1_Click()

Dim filename As String
Dim sl As Integer
Dim acadApp As Object
Dim acadDoc As Object
Dim sset As Object
Dim pViewport As Object
 'declare variables
 

 
Set acadApp = CreateObject("Autocad.Application")
'open AutoCAD

   If Err Then
    'if there is an error

        MsgBox Err.Description
    'inform user

        Exit Sub
    'exit application

    End If

'End If


acadApp.Visible = True
'Make Autocad Visible

Set acadDoc = acadApp.ActiveDocument
'set reference to active document

Me.Hide
'Hide the dialogue box

filename = Dir(dirname, vbNormal)
'retrieve the first entry

Do While filename <> ""
'start the loop

If UCase(Right$(filename, 4)) = ".DWG" Then
'ignore files that do not end with .DWG

If (GetAttr(dirname & filename) And vbNormal) = vbNormal Then
'use bitwise comparison to make sure filename is not a directory

acadDoc.Open dirname & filename
'open drawing to purge

mylen = Len(filename)
'get the length of the filename

mylen = mylen - 4
'subtract the .DWG Extension

filename1 = Left(filename, mylen)
'retrieve the drawing name

Set pViewport = acadDoc.ActiveViewport
'set reference to the viewports

pViewport.ZoomExtents
'zoom to extents

Set sset = acadDoc.SelectionSets.Add("NEWSS")
'set reference to election set

sset.Select acSelectionSetAll
'select the whole drawing

acadDoc.Export dirname & filename1, "WMF", sset
'export the drawing

acadDoc.Save
'save the drawing

    End If
End If

filename = Dir
'get the next entry

Loop
'carry on looping

acadApp.Quit
'Close Autocad

filename = Dir(dirname, vbNormal)
'retrieve the first entry

sl = 1

Do While filename <> ""
'start the loop

If UCase(Right$(filename, 4)) = ".WMF" Then
'ignore files that do not end with .WMF

If (GetAttr(dirname & filename) And vbNormal) = vbNormal Then
'use bitwise comparison to make sure filename is not a directory


    ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add _
    (Index:=sl, Layout:=ppLayoutBlank).SlideIndex
    'insert a new slide
    
    ActiveWindow.Selection.SlideRange.Shapes.AddPicture _
    (filename:=filename, LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, Left:=-2, Top:=58, Width:=727, _
    Height:=423).Select
    'import WMF File into slide
    
    sl = 1 + sl
    'increment the slide number
    
End If

End If

filename = Dir
'get the next entry

Loop
'carry on looping

MsgBox ("Process Complete.."), , "Drawings to Slide"
'inform user that we have finished

End

End Sub

Private Sub CommandButton2_Click()
End

End Sub 

If you would like a copy of this module, just click here. Enjoy.......