Skip to content

Instantly share code, notes, and snippets.

@rumaniel

rumaniel/copyClipboard.vba

Created July 3, 2019 06:41
Show Gist options
  • Save rumaniel/5713ff8f89d1f8484fcf882f5848145a to your computer and use it in GitHub Desktop.
Save rumaniel/5713ff8f89d1f8484fcf882f5848145a to your computer and use it in GitHub Desktop.
Download ZIP
Read row and column and copy to clipboard. cells(row, column) eqauls range(좌표).value
Raw
copyClipboard.vba
Const pGene As Integer = 24 '출력 시작하는 row
Sub Input_Button_Click() 'Generate Button Click시
Dim cAttrib As Integer
Dim cName As Integer
cAttrib = 0
Do While Sheet1.Range("B" & 4 + cAttrib).Value <> "" '속성 개수 카운트
cAttrib = cAttrib + 1
Loop
Do While Sheet1.Cells(3, 3 + cName) <> "" '이름 개수 카운트
cName = cName + 1
Loop
For i = 1 To cName '출력해야되는 갯수만큼
For j = 1 To cAttrib + 1 '속성 수만큼
Sheet1.Range("C" & pGene + j + ((cAttrib + 1) * (i - 1))).Value = Sheet1.Cells(3 + cAttrib + j, 2 + i)
Next
Next
End Sub
Sub Clear_Button_Click() 'Clear Button Click 시
Dim cGene As Integer
cGene = 0
Do While Sheet1.Range("C" & pGene + cGene + 1).Value <> ""
cGene = cGene + 1
Loop
For i = pGene To cGene + pGene
Sheet1.Range("C" & i).Value = ""
Next
End Sub
Public Function Set_Clipboard(ByRef sText As String) As Boolean 'Clipboard에 데이터 카피
Dim obj As DataObject
If obj Is Nothing Then
Set obj = New DataObject
End If
If sText <> "" Then
obj.SetText sText
obj.PutInClipboard
Set_Clipboard = True
Else
Set_Clipboard = False
End If
End Function
Sub Copy_Clipboard() ' Copy button click 시
Dim cString As String
Dim cGene As Integer
Dim Tog As Boolean
Tog = False
cGene = 0
Do While Sheet1.Range("c" & pGene + cGene + 1).Value <> ""
cGene = cGene + 1
cString = cString & Sheet1.Range("c" & pGene + cGene + 1).Value & vbCrLf
Loop
Tog = Set_Clipboard(cString)
If Tog Then
MsgBox "Copy to Clipboard"
Else
MsgBox "Fail to Copy"
End If
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment