Взял и вставил. Как получить данные из буфера обмена?
Главные вкладки
В этой статье я рассмотрю несколько способов доступа к буферу обмена.
Попробуйте скопировать несколько строк из таблицы в файле Word и вставить в Excel. Можно заметить, что вставляется тоже таблица. А если скопировать таблицу с сайта? Тоже таблица при вставке. Как же научить программу понимать скопированные таблицы? Следите за руками!
Для начала небольшой эксперимент. Возьму и вставлю таблицу из Excel в блокнот:
Включаю отображение всех символов и вижу, что между колонками знаки табуляции, а между строками CrLf (Enter). Вот это поворот! Получается, для использования у себя скопированной таблицы нам нужно получить содержимое буфера обмена и обработать его.
Первый пример сделан на LangMF и отображает окно с кнопкой. При нажатии на кнопку из буфера обмена мы получаем таблицу и формируем ListView
<#--Develop="info@skywalkeradmin.ru">
<#Module=mdlMain>
Dim LV
Dim Clip
Dim RowsN
Const lvwReport = 3
Const lvwColumnRight = 1
Const lvwColumnCenter = 2
Const LVM_GETTOPINDEX = 4135
Const LVM_GETCOUNTPERPAGE = 4136
Sub Load(cmdLine)
form.show
End Sub
<#Module>
<#Form=Form>
Sub Form_Load()
On Error Resume Next
form.move 0, 0, 16800, 9600
form.caption = "Скопируйте таблицу в буфер обмена. Первый столбец - названия полей, второй - описание."
form.style.maxbutton = true
form.add "command", 1, ".move 4440, 5040, 3000, 300", ".Caption = ""Вставить из буфера обмена"""
form.center
sys.Licenses.Add "MSComctlLib.ListViewCtrl" ' Здесь и далее для создания интерфейса используется Windows Forms это обычные элементы окон ОС
Set LV = form.CreateOCX("LV", "MSComctlLib.ListViewCtrl")
Set Clip=sys.Clipboard ' Объект - буфер обмена
LV.object.view = lvwReport
LV.object.FullRowSelect = True
LV.object.Borderstyle = 0
form.add "text",1
form.text(1).text="urn:"
form.text(1).move 1716, 432, 1368, 276
form.add "text",2
form.text(2).text="Name:"
form.text(2).move 1716, 432, 1368, 276
End Sub
Sub Form_Activate()
'Call ListProcess
End Sub
Sub Form_Resize()
if isobject(LV) and form.windowstate <> 1 then
LV.move 120,120, form.scalewidth - 360, form.scaleheight - 600
form.command(1).move form.scalewidth / 2 - 600, form.scaleheight - 420
form.command(2).move form.scalewidth / 4 , form.scaleheight - 420
form.text(1).move form.scalewidth/4-4000, form.scaleheight - 420
form.text(2).move form.scalewidth/4-2000, form.scaleheight - 420
end if
End Sub
Sub Command1_Click()
mainstr=Clip.GetText ' Получаем текст из буфера
sRow=Split(mainstr,vbCrLf) ' Создаем массив, разделяя содержимое буфера на строки. Символ разделитель vbCrLf
sCell=Split(sRow(0),vbTab) ' Создаем массив, разделяя строки на столбцы. Символ разделитель vbTab
RowsN=UBound(sCell) ' Вычисляем количество столбцов
Lsize=8000
LV.object.ColumnHeaders.Add , , "Наименование поля", Lsize
LV.object.ColumnHeaders.Add , , "Описание поля", Lsize
LV.Visible = true
for i=1 to UBound(sRow)-1 ' Тут цикл перебирает все строки
sCell=Split(sRow(i),vbTab)
if UBound(sCell)<>RowsN then msgbox UBound(sCell)&vbCrLf&i
if VarType(sCell(0))=vbString and not isNull(sCell(0)) then
Set Item = LV.object.ListItems.Add (,,sCell(0))
else
Set Item = LV.object.ListItems.Add (,,"nas")
end if
ii=1
for each elem in sCell ' А тут перебираем столбцы
if ii<=RowsN then
if ii>UBound(sCell) then ii=ii-1
Item.SubItems(ii) = sCell(ii) ' и вставляем их на форму
ii=ii+1
end if
next
next
If Err.Number<>0 then msgbox Err.Description
End Sub
Sub Form_Unload()
endmf
End Sub
<#Form>А что если вы на необитаемом острове и у вас нет LangMF? А есть только эта статья, напечатанная в "Науке и жизнь" за 2090 год?
Тогда на помощь придет HTA!
Вот пример того же самого инструмента без использования каких либо библиотек, все только на православном Windows
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<HTA:APPLICATION
ID="Copy_gui"
APPLICATIONNAME="CopyApp"
SCROLL="no"
SINGLEINSTANCE="no"
WINDOWSTATE="normal"
MAXIMIZEBUTTON="no"
CONTEXTMENU="yes"
CAPTION="yes"
BORDER="thin"
BORDERSTYLE="normal"
ICON="xsd_maker.ico"
SELECTION="yes">
<style>
form {
font-family: 'Verdana'
font-size: 250%; /* Размер шрифта в процентах */
}
</style>
<SCRIPT LANGUAGE="VBScript">
'Размеры окна
window.resizeTo 500, 600
'Отрисовка окна в центре экрана
window.moveTo screen.width/2-500/2, 0
sub pasteit
On Error Resume Next
strClipboard = ""
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
strClipboard = objIE.document.parentWindow.clipboardData.getData("text")
objIE.Quit
On Error Goto 0
HTMLstr = "<title>Создание XSD</title><center><table border='1' width='100' bordercolorlight='#000000' cellspacing='0' bordercolordark='#C0C0C0' style='border-collapse: collapse; font-family: Verdana; font-size: 8pt'>"+vbcr+"<tr><td >" &_
"<b>Наименование поля</b></td><td><b>Описание поля</b></td>"
mainstr=strClipboard
if mainstr="" then exit sub
sRow=Split(mainstr,vbCrLf)
if UBound(sRow)<1 then
MsgBox "Так не пойдет."&vbCrLf &"В буфере обмена нет нужных данных!",vbInformation,"Результат не сохранен"
exit sub
end if
sCell=Split(sRow(0),vbTab)
RowsN=UBound(sCell)
if UBound(sCell)=1 then
for i=0 to UBound(sRow)-1
sCell=Split(sRow(i),vbTab)
if UBound(sCell)<>RowsN then msgbox UBound(sCell)&vbCrLf&i
if VarType(sCell(0))=vbString and not isNull(sCell(0)) then
HTMLstr=HTMLstr+"<tr><td>"+Cstr(sCell(0))+"</td>"
else
HTMLstr=HTMLstr+"<tr><td>nan</td>"
end if
ii=1
for each elem in sCell
if ii<=RowsN then
if ii>UBound(sCell) then ii=ii-1
HTMLstr=HTMLstr+"<td>"+Cstr(sCell(ii))+"</td>"
ii=ii+1
end if
next
next
HTMLstr=HTMLstr+"</table>"
else
HTMLstr=HTMLstr+"</table>"
HTMLstr=HTMLstr+"<b><h1 style='font-family: Verdana'>Таблица не верного формата</h1></b><p style='font-family: Verdana'>Файл пуст!</p>"
end if
'HTMLstr=HTMLstr+"<br><br><input onclick='makexsdfile' type='button' value='Сформировать файл XSD' style='font-family: Verdana; font-size: 8pt'>"
urn=InputBox ("Введите URN:","Необходимо указать","urn:")
xname=InputBox ("Введите Namespace:","Необходимо указать","name")
if urn="" then urn="urn:"
if xname="" then xname="name"
Set WshShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(WshShell.CurrentDirectory)
Set objFolderItem = objFolder.Self
Set objFSO = CreateObject("Scripting.FileSystemObject")
Path = objFolderItem.Path + ""
Set objFSO = CreateObject("Scripting.FileSystemObject") ' Подключаемся к файловой системе
XSDFilePath=Path&"xsd_from_clipboard.xsd"
If objFSO.FileExists(XSDFilePath) = 1 Then objFSO.DeleteFile(XSDFilePath)
If objFSO.FileExists(XSDFilePath) = 0 Then 'Содаем файл, если его нет.
set objTSXSD = objFSO.CreateTextFile(XSDFilePath)
objTSXSD.Close
End If
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
XSD1="<xsd:schema xmlns:xsd="&Chr(34)&"http://www.w3.org/2001/XMLSchema"&Chr(34)&" xmlns="&Chr(34)&urn &Chr(34)&" targetNamespace="&Chr(34)&xname &">"&vbCrlf &" <xsd:complexType name="&Chr(34)&xname &Chr(34)&">"&vbCrLf &" <xsd:annotation>"&vbCrLf &" <xsd:documentation xml:lang="&Chr(34)&"EN"&Chr(34)&">"
objStream.WriteText XSD1 &vbCrlf
objStream.WriteText "Некоторое описание"&vbCrlf
objStream.WriteText "</xsd:documentation>" &vbCrlf
objStream.WriteText "</xsd:annotation>" &vbCrlf
objStream.WriteText " <xsd:sequence>" &vbCrlf
for i=0 to UBound(sRow)-1
sCell=Split(sRow(i),vbTab)
if UBound(sCell)=1 then
objStream.WriteText " <xsd:element name="&Chr(34)& Cstr(sCell(0)) & Chr(34)&">" &vbCrlf
objStream.WriteText " <xsd:annotation>" &vbCrlf
objStream.WriteText " <xsd:documentation>" &vbCrlf
objStream.WriteText " "&Cstr(sCell(1)) &vbCrlf
objStream.WriteText " </xsd:documentation>" &vbCrlf
objStream.WriteText " </xsd:annotation>" &vbCrlf
objStream.WriteText " <xsd:simpleType>" &vbCrlf
objStream.WriteText " <xsd:restriction base="&Chr(34)&"xsd:string"&Chr(34)&">" &vbCrlf
objStream.WriteText " <xsd:maxLength value="&Chr(34)&"10"&Chr(34)&" />" &vbCrlf
objStream.WriteText " </xsd:restriction>" &vbCrlf
objStream.WriteText " </xsd:simpleType>" &vbCrlf
objStream.WriteText " </xsd:element>" &vbCrlf
end if
next
objStream.WriteText " </xsd:sequence>" &vbCrlf
objStream.WriteText " </xsd:complexType>" &vbCrlf'Конец файла
objStream.WriteText "</xsd:schema>"
objStream.SaveToFile XSDFilePath, 2
HTMLstr=HTMLstr+"<p style='font-family: Verdana'>Все поля имеют тип string, длиной 10 символов</p>"
HTMLstr=HTMLstr+"<p style='font-family: Verdana; font-size: 8pt'>Завершено. Создан файл: </p><br><i><p>"&XSDFilePath&"</i></p>"
document.write (HTMLstr)
end sub
</SCRIPT>
<title>Создание XSD</title>
<body style='background-color: #c5c5e3;'>
<center>
<br><p style='font-family: Verdana'>Для корректной работы необходимо, чтобы в буфер обмена была скопирована таблица из двух столбцов.<br><br>Первый: название поля<br>Второй: описание поля<br><br>По нажатию кнопки, появится диалоговое окно доступа к буферу обмена. Согласитесь дать доступ. Если окно не отвечает, завершите процессы iexplore.exe через диспетчер задач</p><br>
<p style='font-family: Verdana'>Так же необходимо указать URN и Namespace для datatype (или добавить их в файл позже)<br><br>
<input onclick="pasteit" type="button" value=" Сформировать XSD " style="font-family: Verdana; font-size: 12pt; border: 2px solid #000000;"><br><br><br>
<i>Разработка и поддержка Кулаковский М.Г.<br><a href='mailto:info@skywalkeradmin.ru'>info@skywalkeradmin.ru/a></i>
</body>
</html>Тут я решаю уже практическую задачу, из содержимого буфера обмена создается XSD файл. Обращаю ваше внимание, что доступ к буферу обмена получаем через такую загогулину:
On Error Resume Next
strClipboard = ""
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
strClipboard = objIE.document.parentWindow.clipboardData.getData("text")
objIE.Quit
On Error Goto 0Т.е. через Internet Explorer со всеми вытекающими нюансами.
Можно еще реализовать подобное решение на WSO но это пусть будет вам домашним заданием.
Asics Gel Cumulus Mens Sale, Asics Gel Cumulus 20 Mens Sale Asics Gel Cumulus Mens Sale, Asics Gel Cumulus 20 Mens Sale, ASICS® Gel-Cumulus 21 - Men's Midnight/Midnight
New Balance 577 Red Black, New Balance 577 Womens Black New Balance 577 Red Black, New Balance 577 Womens Black, New Balance 577 Hook & Loop - Men's Black
- Блог пользователя Матвей
- Войдите или зарегистрируйтесь, чтобы отправлять комментарии
Новые комментарии