вот код,
- Код: Выделить всё
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim xlApp As New Excel.Application
Dim xlMappe As Excel.Workbook
xlMappe = _
xlApp.Workbooks.Open("C:\Statistik.xls")
Dim PShape As Shape, hStrPtr As Long ' Microsoft.Office.Core.MsoShapeType
For Each PShape In xlMappe.Worksheets(1).Shapes
'If PShape.Type = msoPicture Then
If PShape.Type = Microsoft.Office.Core.MsoShapeType.msoPicture Then
PShape.CopyPicture()
If Not CBool(OpenClipboard(0&)) Then
MsgBox("Cant open buffer")
GoTo NextSh
End If
hStrPtr = GetClipboardData(CF_ENHMETAFILE)
If Not CBool(hStrPtr) Then
MsgBox("Cant get a descriptor")
GoTo CloseClip
End If
If Not CBool(CopyEnhMetaFile(hStrPtr, "c:\" & "pic" & hStrPtr & ".emf")) Then
MsgBox("Cant write File")
GoTo CloseClip
End If
CloseClip:
CloseClipboard()
NextSh:
xlMappe.Close()
xlApp.Quit()
End If
Next
End Sub
ошибок не дает но картинку тоже не сохраняет
Помогите пожалуиста
Full code:
- Код: Выделить всё
Imports System.Windows.Forms
Imports Office = Microsoft.Office.Core '
'Imports Microsoft.Office.Core.MsoShapeType
'Imports Excel = Microsoft.Offi
'mports MSForms = Microsoft.Vbe.Interop.Forms
Public Class Form1
Inherits System.Windows.Forms.Form
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Const CF_ENHMETAFILE As Long = 14
#Region " Windows Form Designer generated code "
Public Sub New()
MyBase.New()
'This call is required by the Windows Form Designer.
InitializeComponent()
'Add any initialization after the InitializeComponent() call
End Sub
'Form overrides dispose to clean up the component list.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
Friend WithEvents Button1 As System.Windows.Forms.Button
Friend WithEvents Button2 As System.Windows.Forms.Button
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.Button1 = New System.Windows.Forms.Button
Me.Button2 = New System.Windows.Forms.Button
Me.SuspendLayout()
'
'Button1
'
Me.Button1.Location = New System.Drawing.Point(0, 0)
Me.Button1.Name = "Button1"
Me.Button1.TabIndex = 0
Me.Button1.Text = "Button1"
'
'Button2
'
Me.Button2.Location = New System.Drawing.Point(216, 0)
Me.Button2.Name = "Button2"
Me.Button2.TabIndex = 1
Me.Button2.Text = "Button2"
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(292, 273)
Me.Controls.Add(Me.Button2)
Me.Controls.Add(Me.Button1)
Me.Name = "Form1"
Me.Text = "Form1"
Me.ResumeLayout(False)
End Sub
#End Region
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'Dim xlApp As Excel.Application
Dim xlApp As New Excel.Application
Dim xlMappe As Excel.Workbook
Dim xlBlatt As Excel.Worksheet
Dim xlZelle As Excel.Range
Dim intZeilen As Integer
' xlApp = New Excel.Application
xlApp.Visible = False
xlMappe = _
xlApp.Workbooks.Open("C:\Statistik.xls")
xlBlatt = xlMappe.Worksheets(1)
xlZelle = xlBlatt.Range("A1")
intZeilen = xlZelle.CurrentRegion.Rows.Count
xlZelle.Offset(intZeilen, 0).Value = intZeilen
xlZelle.Offset(intZeilen, 1).Value = Today()
xlZelle.Offset(intZeilen, 2).Value = "werwer" ' _
'txt 'Name.Text
xlZelle.Offset(intZeilen, 3).Value = "asdasd" ' txtGeld.Text
'Danach muss die Mappe gespeichert und geschlossen werden:
xlMappe.Worksheets(1).Pictures.Insert("C:\Berge.jpg")
xlMappe.Save()
xlMappe.Close()
xlApp.Quit()
'Es ist nicht erforderlich, aber man kann die Objektvariablen leeren:
xlZelle = Nothing
xlBlatt = Nothing
xlMappe = Nothing
xlApp = Nothing
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim xlApp As New Excel.Application
Dim xlMappe As Excel.Workbook
xlMappe = _
xlApp.Workbooks.Open("C:\Statistik.xls")
Dim PShape As Shape, hStrPtr As Long ' Microsoft.Office.Core.MsoShapeType
For Each PShape In xlMappe.Worksheets(1).Shapes
'If PShape.Type = msoPicture Then
If PShape.Type = Microsoft.Office.Core.MsoShapeType.msoPicture Then
PShape.CopyPicture()
If Not CBool(OpenClipboard(0&)) Then
MsgBox("Cant open buffer")
GoTo NextSh
End If
hStrPtr = GetClipboardData(CF_ENHMETAFILE)
If Not CBool(hStrPtr) Then
MsgBox("Cant get a descriptor")
GoTo CloseClip
End If
If Not CBool(CopyEnhMetaFile(hStrPtr, "c:\" & "pic" & hStrPtr & ".emf")) Then
MsgBox("Cant write File")
GoTo CloseClip
End If
CloseClip:
CloseClipboard()
NextSh:
xlMappe.Close()
xlApp.Quit()
End If
Next
End Sub
End Class
