- 帖子
- 109
- 主題
- 2
- 精華
- 0
- 積分
- 114
- 點名
- 0
- 作業系統
- Win7 Win10
- 軟體版本
- Office 2019 WPS
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 深圳
- 註冊時間
- 2013-2-2
- 最後登錄
- 2024-11-6
|
2#
發表於 2019-2-23 11:12
| 只看該作者
- #If VBA7 Then
- Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
- #Else
- Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
- #End If
- Private Sub CommandButton4_Click()
- Dim abc As Range
- Dim f As Range
- Dim rngCopy As Range
-
- Set f = Range("a1")
- Set abc = Range("o2:o1000").Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious, LookAt:=xlWhole)
-
- Set rngCopy = Range(f, abc.Offset(1, 2))
- rngCopy.CopyPicture Format:=xlBitmap
- With Sheet2.ChartObjects.Add(0, 0, rngCopy.Width, rngCopy.Height).Chart
- DoEvents
- WaitTimes 200
- .Paste
- ' .Export Filename:="r:\temp\ABC.JPG", FilterName:="JPG"
- .Export Filename:="c:\1.JPG", FilterName:="JPG"
- .Parent.Delete
- End With
- End Sub
- Private Sub WaitTimes(ByVal lngTime As Long)
- Do While lngTime > 0
- DoEvents
- Sleep 20
- lngTime = lngTime - 20
- Loop
- End Sub
|
|
