vba 插入图片

Sub 插入图片()

    Dim i As Integer
    
    For i = 1 To ActivePresentation.Slides.Count
    ActivePresentation.Slides(i).Select
    With ActiveWindow.Selection.SlideRange
    .FollowMasterBackground = msoFalse
   

 

.Background.Fill.UserPicture "C:/Documents and Settings/Administrator/桌面/mjs/新建文件夹/" & i & ".jpg"

    
    .Shapes.AddPicture(FileName:="C:/Documents and Settings/Administrator/桌面/mjs/新建文件夹/" & i & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=323, Top:=233, Width:=75, Height:=75).Select

.Shapes.AddPicture(FileName:="C:/Documents and Settings/Administrator/桌面/mjs/新建文件夹/b" & i & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=323, Top:=233, Width:=75, Height:=75).Select
    End With
    Next
End Sub

 

 

 

ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 223.875, 77.25, 175.875, 28.875).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoTrue
With ActiveWindow.Selection.TextRange.ParagraphFormat
.LineRuleWithin = msoTrue
.SpaceWithin = 1
.LineRuleBefore = msoTrue
.SpaceBefore = 0.5
.LineRuleAfter = msoTrue
.SpaceAfter = 0
End With

 

 

 

 

 

 

 

 

 

 

 

 

 

Sub w()

'Dim cnn
'Set cnn = ADODB.Connection
'Dim rst
'rst = ADODB.Recordset
'cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0 ;Data Source=G:/Documents and Settings/Administrator/桌面/yyhxiugai-GZEX饮用水软文11月.mdb;Persist Security Info=False"
'cnn.Open
'rst.Open("select   *   from  cdrecord",   cnn)

'Dim strsql, conn, rs
  'Dim connstring
  'connstring = "DRIVER={Microsoft   Access   Driver   (*.mdb)};   DBQ=" & server.MapPath(".") & "yyhxiugai-GZEX饮用水软文11月.mdb"
  'connstring = "DRIVER={Microsoft   Access   Driver   (*.mdb)};   DBQ=yyhxiugai-GZEX饮用水软文11月.mdb"
  'connstring = "DRIVER={Microsoft   Access   Driver   (*.mdb)};   DBQ=G:/Documents and Settings/Administrator/桌面/yyhxiugai-GZEX饮用水软文11月.mdb"
   
  'Set conn = server.CreateObject("ADODB.Connection")
  'conn.Open connstring
   
  'strsql = "select   *   from cdrecord"
  'rs.Open strsql, conn
 
 
 
 ' Dim oOleDbConnection As OleDb.OleDbConnection
'Dim sConnString As String

'sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                     "Data Source=G:/Documents and Settings/Administrator/桌面/yyhxiugai-GZEX饮用水软文11月.mdb;" & _
                     "User ID=;" & _
                     "Password="";"
'oOleDbConnection = New OleDb.OleDbConnection(sConnString)
'oOleDbConnection.Open()

'DoCmd.OutputTo acOutputTable, [objectname], [outputformat], [outputfile], [autostart]
 
 
 
 
'StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "/DbPrice.accdb" & ";Persist Security Info=False"
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:/Documents and Settings/Administrator/桌面/yyhxiugai-GZEX饮用水软文11月.mdb;Persist Security Info=False"
    Set Conn = New ADODB.Connection
    Conn.Open StrConn

 Sql = "select * from cdrecord"
 Set Rs1 = Conn.Execute(Sql)

Dim i
i = 0

Do While Not Rs1.EOF
        'activesheet.Cells(i, j).Value = Rs1("colno")
   i = i + 1
        ActivePresentation.Slides.Add (ActivePresentation.Slides.Count + 1), ppLayoutBlank

ActivePresentation.Slides(i).Select
    With ActiveWindow.Selection.SlideRange
    .FollowMasterBackground = msoFalse
   
'.Background.Fill.UserPicture "C:/Documents and Settings/Administrator/桌面/mjs/" & i & ".jpg"

   
.Shapes.AddPicture(FileName:="C:/Documents and Settings/Administrator/桌面/mjs/" & i & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=30, Top:=30, Width:=75, Height:=30).Select

.Shapes.AddPicture(FileName:="C:/Documents and Settings/Administrator/桌面/mjs/b" & i & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=-1, Height:=-1).Select

With ActiveWindow.Selection.ShapeRange
        .IncrementLeft 360#
        .IncrementTop 270#
End With

.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=20, Top:=0, Width:=600, Height:=50).TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Text = Rs1("notes")
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters.Font.Size = 12
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters.Font.Color = -8040169

.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=20, Top:=20, Width:=600, Height:=50).TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Text = Rs1("nspdate")
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters.Font.Size = 12
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters.Font.Color = -8040169

.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=20, Top:=40, Width:=600, Height:=50).TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Text = Rs1("soawp") & " " & Rs1("sowapname2")
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters.Font.Size = 12
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters.Font.Color = -8040169

    End With

        Rs1.MoveNext
    Loop
 
  Rs1.Close
 
For i = 1 To 2

'ActivePresentation.Slides.Add (ActivePresentation.Slides.Count + 1), ppLayoutBlank

Next i
'MsgBox ("Ten blank slides have been added.")

 

End Sub
'