I am writing a report function and I use the clipbord to transport data (with in Excel or to Word). Ideally I would like to clear the clipbord memory after every paste transaction.
Any help appreciated.
Code
Application.ScreenUpdating = False
Do Until weiter = False
dummy = Sheets("3d rotate").Cells(1000 + ii, 1 + i)
If dummy <> "" Then
decoded_link = Sheets("3d rotate").Cells(2000 + ii, 1 + i)
Application.Run "transfer_column_diagram_data", i, ii, replicate, j, dummy
part1 = Sheets("3d rotate").Cells(13999 + decoded_link, 15) & Sheets("3d rotate").Cells(13999 + decoded_link, 11)
part2 = Sheets("3d rotate").Cells(13999 + decoded_link, 10)
Select Case replicate
Case 1
Sheets("3d rotate").ChartObjects("Chart 1").CopyPicture
Case 2
Sheets("3d rotate").ChartObjects("Chart 2").CopyPicture
Case 3
Sheets("3d rotate").ChartObjects("Chart 3").CopyPicture
Case 4
Sheets("3d rotate").ChartObjects("Chart 5").CopyPicture
End Select
Sheets("detailed results").Select
If Graphcount = 0 Then
Sheets("detailed results").Cells(5 + i + j, 2).Select
'ActiveSheet.Paste
Sheets("detailed results").Paste
Sheets("detailed results").Cells(4 + i + j, 2).Select ' = ii + 1 & " " & dummy
'ActiveSheet.Hyperlinks.Add
Sheets("detailed results").Hyperlinks.Add _
Anchor:=Selection, Address:=part1, TextToDisplay:=ii + 1 & " " & part2
Else
Sheets("detailed results").Cells(5 + i + j, 9).Select
'ActiveSheet.Paste
Sheets("detailed results").Paste
Sheets("detailed results").Cells(4 + i + j, 9).Select ' = ii + 1 & " " & dummy
Sheets("detailed results").Hyperlinks.Add _
Anchor:=Selection, Address:=part1, TextToDisplay:=ii + 1 & " " & part2
End If
Graphcount = Graphcount + 1
If Graphcount = 2 Then
Graphcount = 0
j = j + Y_distance
End If
ii = ii + 1
'msg = MsgBox("ii : " & ii & "maxhits " & Max_Hits)
Else
weiter = False
If ii = 0 Then
j = j + Y_distance
End If
j = j + 1
End If
If ii > Max_hits - 1 Then
j = j + Y_distance
weiter = False
End If
Loop
Application.ScreenUpdating = True
Any help appreciated.
Code
Application.ScreenUpdating = False
Do Until weiter = False
dummy = Sheets("3d rotate").Cells(1000 + ii, 1 + i)
If dummy <> "" Then
decoded_link = Sheets("3d rotate").Cells(2000 + ii, 1 + i)
Application.Run "transfer_column_diagram_data", i, ii, replicate, j, dummy
part1 = Sheets("3d rotate").Cells(13999 + decoded_link, 15) & Sheets("3d rotate").Cells(13999 + decoded_link, 11)
part2 = Sheets("3d rotate").Cells(13999 + decoded_link, 10)
Select Case replicate
Case 1
Sheets("3d rotate").ChartObjects("Chart 1").CopyPicture
Case 2
Sheets("3d rotate").ChartObjects("Chart 2").CopyPicture
Case 3
Sheets("3d rotate").ChartObjects("Chart 3").CopyPicture
Case 4
Sheets("3d rotate").ChartObjects("Chart 5").CopyPicture
End Select
Sheets("detailed results").Select
If Graphcount = 0 Then
Sheets("detailed results").Cells(5 + i + j, 2).Select
'ActiveSheet.Paste
Sheets("detailed results").Paste
Sheets("detailed results").Cells(4 + i + j, 2).Select ' = ii + 1 & " " & dummy
'ActiveSheet.Hyperlinks.Add
Sheets("detailed results").Hyperlinks.Add _
Anchor:=Selection, Address:=part1, TextToDisplay:=ii + 1 & " " & part2
Else
Sheets("detailed results").Cells(5 + i + j, 9).Select
'ActiveSheet.Paste
Sheets("detailed results").Paste
Sheets("detailed results").Cells(4 + i + j, 9).Select ' = ii + 1 & " " & dummy
Sheets("detailed results").Hyperlinks.Add _
Anchor:=Selection, Address:=part1, TextToDisplay:=ii + 1 & " " & part2
End If
Graphcount = Graphcount + 1
If Graphcount = 2 Then
Graphcount = 0
j = j + Y_distance
End If
ii = ii + 1
'msg = MsgBox("ii : " & ii & "maxhits " & Max_Hits)
Else
weiter = False
If ii = 0 Then
j = j + Y_distance
End If
j = j + 1
End If
If ii > Max_hits - 1 Then
j = j + Y_distance
weiter = False
End If
Loop
Application.ScreenUpdating = True