» Excel VBA (часть 3)

Teleri
Есть событие книги NewSheet. В него и вставить код содания гиперссылок.

Доброго времени суток, есть такой вопрос:

Есть табличка в Excelе,
есть форма с полями для ввода текста в эту табичку,
есть кнопочка "Добавить",

необходимо чтобы при нажатии кнопки создавалась новая строка с данными значениями из полей.

И с последующим нажатии на кнопку, так же создавалась новая строчка с данными из формы.

Для наглядности приклепляю файл: http://zalil.ru/31761020

Strong64
Я вам форму нарисую, а код пишите сами :) А в чем проблема-то?
Включить рекордер, добавить строку, заполнить ручками поля в таблице, выключить рекордер. Модифицировать полученный код, заменив абсолютные значения на .Value (в общем случае) соответствующих боксов формы и подставить его в событие кнопки Click. По аналогии поступить с другими кнопками.

Бзв, судя по задоженному функционалу кнопок - это задача для Access.

asbo
Спасибо, что то и забыл про рекордер.... Да, конечно, мы хотим сделать в MSSQL пока еще в голове все вращается... на C# программку хотим создать чтоб в базу данных всё вводило, а потом каждый пользователь брал от туда что ему нужно... А вот есть ли возможность потом эту так скажем "базу данных" в екселе экспортировать в базу данных SQL ? Или лучше сразу уж создавать базу в SQL?

Strong64
Я ужЕ где-то писал: Ексель - прекрасное средство для моделирования. Можно не боясь вводить рабочие данные в базу - возможностей для экспорта через внешний формат хватает, как и возможностей импорта у сторонних СУБД. Да и собственно к листу можно обратиться запросом из любой СУБД через ODBC.

Братцы, хочу, чтоб в ячейке отображался путь папки, в которой лежит данный файл.
В формулах такого не нашёл, а в нете откапал нечто, вроде, похожее:

Код: iPath = ThisWorkbook.Path

Likseich
К србытию какому-нибудь надо прикручивать. Или книги, или листа. Допустим, к открытию книги, в модуле "Эта книга":
Private Sub Workbook_Open()
Cells(1, 1).Value = ThisWorkbook.Path
End Sub

И, на сколько я понимаю, при открытии файла в ячейке A1 (листа, куда я это торкнул) должен прописаться путь...
Но, почему-то не пишет

Likseich
Дык, ну как же так... на ровном месте спотыкач... ошибаться-то там негде...
Вот

Спасибо за примерчик.
А я, влепил этот код напрямую в лист.
Такой уж из меня програмер
Ещё раз - ОГРОМНОЕ СПАСИБО!

:)

Всем доброго времени суток. Что то не смог найти ответ на свой вопрос, а вопрос такой.
Необходимо сформировать средствами VBA xml файл, все бы ничего, но у мменя не получается структура та, которая мне нужна.

Структура xml которая мне нужна:

Код:
<?xml version="1.0" encoding="Utf-8"?>
<Document-InventoryReport>
    <InventoryReport-Header><!-- Шапка отчёта -->
        <InventoryReportNumber>1001</InventoryReportNumber> <!-- Номер отчёта -->
        <InventoryReportDate>2011-04-10</InventoryReportDate> <!-- Дата отчёта -->
        <PeriodStartDate>2011-04-10</PeriodStartDate> <!-- Дата начала периода отчёта (совпадает с датой отчёта) -->
        <PeriodEndDate>2011-04-10</PeriodEndDate> <!-- Дата конца периода отчёта (совпадает с датой отчёта) -->
        <DocumentFunctionCode>O</DocumentFunctionCode> <!-- Статус O (оригинал) -->
        <DocumentNameCode>172</DocumentNameCode> <!-- Номер имени документа (по умлочанию 172) -->
        <ExpectedDeliveryDate>2011-04-12</ExpectedDeliveryDate> <!-- Ожидаемая дата доставки -->
        <ProductGroups> <!-- Товарные группы -->
            <ProductGroup> <!-- Линия товарной группы -->
<GroupName>GUM</GroupName> <!-- Название товарной группы (GUM - жевательная резинка) -->
<TotalGroupAmount>5000.00</TotalGroupAmount> <!-- Объём SSU указанной группы -->
         </ProductGroup>
         <ProductGroup> <!-- Линия товарной группы -->
<GroupName>CONFECTIONS</GroupName> <!-- Название товарной группы (CONFECTIONS - конфеты) -->
<TotalGroupAmount>6000.00</TotalGroupAmount> <!-- Количество в SSU указанной группы -->
         </ProductGroup>
         <ProductGroup> <!-- Линия товарной группы -->
<GroupName>SNACKS</GroupName> <!-- Название товарной группы (SNACKS - сухарики) -->
<TotalGroupAmount>7000.00</TotalGroupAmount> <!-- Количество в SSU указанной группы -->
         </ProductGroup>
        </ProductGroups>
    </InventoryReport-Header>

asbo

Цитата:

Есть событие книги NewSheet. В него и вставить код содания гиперссылок.

можно пример макроса?

Добавлено:
еще один возник вопрос..

есть папка в ней файлы, на эти файлы в табличке ексель гиперссылки.. файлы периодически перемещаются в подпапку "Сompleted" (все в рамках вышеуказанной папки/диска..)

при таком раскладе гиперссылки умирают

идея состоит в том чтобы при создании гиперссылок или путем их проверки можно было чекать попал ли файл в "Comleted", если попал то фиксировать за ним этот новый адрес в гиперсылке, если нет сохранять старый..

выглядит несложно, но как такое написать в виде макроса не знаю.. также хотелось бы пример!

заранее спасибо!

Teleri
Как говорил командир моей роты капитан ****: "Да, можно ... " и далее по тексту.
Ведь парой постов ниже твоего мой пост - "Включить рекордер, [что-то сделать], выключить рекордер. Модифицировать полученный код, заменив [что-то на что-то] и подставить его в событие ... "

В шапке:
Обратите внимание, этот топик для помощи в изучении и использовании VBA. Посему запросы типа "Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" не приветствуются.

Обскажи, плз, в чем помочь-то? Прошло столько дней.. что-то конкретно не получилось? Или рекордер не работает?


Добавлено:
Teleri

Цитата:

еще один возник вопрос..

При таком раскладе, если гиперссылки в рамках одного только, головного, так скажем, документа, то проверять на круг все ссылки на наличие конкретного файла (или может есть код ошибки специфический - спецы подскажут, если что) в соответствующей папке, и если что поравить ссыль. Но тут такой датафлоу получается - планктон любую схему запорет. Модель еще можно собрать, а работать - не будет. Простая коллизия - один перепещает документ, а второй копирует. И таких можно напридумывть тыщи. Шары в ход пойдут... и понеслась...

Звыняй - опять бэз кода, а лишь концептуально... :((

я самоучка и только начинаю..

мне удобнее ковыряться с простейшими примерами

[more=Вот что получилось]Sub Макрос1()
'
' Макрос1 Макрос
'

'
Range("A2").Select
ActiveCell.FormulaR1C1 = "=Лист2!R[-1]C"
Range("A2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист2!A1"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=Лист2!RC"
Range("B2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист2!B2"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=Лист2!R[1]C[-1]"
Range("C2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист2!B3"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=Лист2!R[2]C[-2]"
Range("D2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист2!B4"
Range("A3").Select
ActiveCell.FormulaR1C1 = "=Лист3!R[-2]C"
Range("A3").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист3!A1"
Range("B3").Select
ActiveCell.FormulaR1C1 = "=Лист3!R[-1]C"
Range("B3").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист3!B2"
Range("C3").Select
ActiveCell.FormulaR1C1 = "=Лист3!RC[-1]"
Range("C3").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист3!B3"
Range("D3").Select
ActiveCell.FormulaR1C1 = "=Лист3!R[1]C[-2]"
Range("D4").Select
Sheets("Лист1").Select
Range("D3").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист3!B4"
End Sub
[/more]

Добавлено:
к сожалению не знаю как сделать так чтобы
макрос работал начиная с заглавной ячейки (первой для каждого листа в примере "А1" и далее по строке
как убрать привязку к листу, т.е. добиться эффекта выбрал на заглавном листе ячейку запустил макрос для определенного листа, получил на заглавном листе строку как в примере

кажется это тут описывали но боюсь не откопаю, кажется там можно создавать окошко которое позволит выбрать из какого листа брать данные для макроса.

Добавлено:

Цитата:

При таком раскладе, если гиперссылки в рамках одного только, головного, так скажем, документа, то проверять на круг все ссылки на наличие конкретного файла (или может есть код ошибки специфический - спецы подскажут, если что) в соответствующей папке, и если что поравить ссыль. Но тут такой датафлоу получается - планктон любую схему запорет. Модель еще можно собрать, а работать - не будет. Простая коллизия - один перепещает документ, а второй копирует. И таких можно напридумывть тыщи. Шары в ход пойдут... и понеслась...
 
Звыняй - опять бэз кода, а лишь концептуально... (

почему.. пост очень даже закодирован

т.е. банальную проверку

лежит файл в основной папке, если да ----> гиперссылка на него в этой папке, если нет действие -----> гиперссылка на подпапку "Completed"

не прокатит?

unit4

Цитата:

Set xmlF = xmlDoc.documentElement.appendChild(xmlDoc.createElement("ProductGroups"))

Тут и зарыто. ProductGroups дочерний к уровню InventoryReport-Header, а не к уровню documentElement

AndVGri
Моя это понимать, однако я нуб в vba. Если я напишу просто

Код:
Set xmlFs = xmlF.appendChild(xmlDoc.createElement("ProductGroups"))

поковырялся немного...


Цитата:

Sub Макрос1()
'
' Макрос1 Макрос
'

'
Range("A2").Select
ActiveCell.FormulaR1C1 = "=Лист2!R[-1]C"
Range("A2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист2!A1"

End Sub

на сколько я понимаю сделав так


Цитата:

Sub Макрос1()
'
' Макрос1 Макрос
'

'
Dim RN As Excel.Range
Set RN = Application.InputBox("Select your favorite cell:", Type:=8)
ActiveCell.FormulaR1C1 = "=Лист2!R[-1]C"
Range("A2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"Лист2!A1"

End Sub

я получу возможность выбирать ячейку в которой должен сработать макрос.. как добавить такую же возможность выбора для этой строчки


Цитата:

ActiveCell.FormulaR1C1 = "=Лист2!R[-1]C"

и чтобы гиперсылка автоматом выбирала соответствующие ячейки... (где создавать и на какой адрес ссылаться)

Teleri
Малехо не так. Надо добавить проверку на нажатие отмены в диалоге. Полученную из дилога строку сохранить в строковой переменной, и, если она не нулевая, передать в объект RN. и Добавить проверку на единственную ячейку, а не диапазон.

Dim sCell
sSell = диалог
If not Len(sCell) > 0 Then
If Not RN Is Nothing Then
Select Ccase RN.Cells.Count = 1
Case True
'...
Case False
'...
End select
End if

Добавлено:
Teleri
Сорри. Не углядел Type:=8
Внес правку

Добавлено:

Цитата:

Не углядел Type:=8

Разве для нее константы нет?

Народ - эт снова я)))
Короче, мне теперь надо парсить xml файл и запихать его в txt. В принципе я научился и то и это, вот код

Код:
Public Sub XMLtoTXT(xmlFileName As String)

Dim xmlDoc As MSXML2.DOMDocument
Dim objNode As IXMLDOMNode
Dim SIC, OQ, OUGP As IXMLDOMNodeList
'Dim objListOfNodes As String

Set xmlDoc = New DOMDocument

xmlDoc.async = False
xmlDoc.validateOnParse = False
xmlDoc.Load (xmlFileName)


xmlDoc.setProperty "SelectionLanguage", "XPath"

Set SIC = xmlDoc.selectNodes("//SupplierItemCode")
Set OQ = xmlDoc.selectNodes("//OrderedQuantity")
Set OUGP = xmlDoc.selectNodes("//OrderedUnitGrossPrice")

Open "D:\trash\test.txt" For Output As #1

For Each objNode In OQ
Print #1, objNode.Text
Next

Close #1

End Sub

unit4

Код:
For Each objNode In SIC
Print #1, objNode.Text
Next
For Each objNode In OQ
Print #1, objNode.Text
Next
For Each objNode In OUGP
Print #1, objNode.Text
Next
Close #1

AndVGri
Дык оно мне не так записало


Код:
182
2
1950
8.000
4.000
22.000
2593.4040
2593.4040
5274.9540

unit4
и..? Объектную модель MSXML посмотреть в Object Browser, по моему, не сложно

Код:
If (SIC.length = OQ.length) And (OUGP.length = OQ.length) Then
For i = 0 To SIC.length - 1
Print #1, SIC(i).text & ";" & OQ(i).text & ";" & OUGP(i).text
End If
End If

AndVGri
Сбасибо большое)
Для меня Объектную модель MSXML посмотреть в Object Browser очень сложно, дабы я не являюсь программистом, я вообще сисадмин, меня насильно заставили писать это приложение))

Что то я не понимаю, все работало, а сейчас вылетает на строчке AtxtSIC = Left(AtxtSIC, Len(AtxtSIC) - 1)

Вот код:


Код:
Public Sub XMLtoTXT()

Dim xmlDoc As MSXML2.DOMDocument
Dim objNode As IXMLDOMNode
Dim SIC, OQ, OUGP As IXMLDOMNodeList
Dim db As ADODB.Connection
Dim rec As ADODB.Recordset
Dim txtSIC, AtxtSIC, xmlFileName, txtFileName As String

Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFiles As Files
Dim objFile As File

Set xmlDoc = New DOMDocument
Set db = New ADODB.Connection
Set rec = New ADODB.Recordset

Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder("D:\trash\")
Set objFiles = objFolder.Files

txtFileName = "D:\trash\test.txt"

date_ord = Cells(2, 1)
date_ord = sd(date_ord)

xmlFileName = "ORDER_" + date_ord + ".xml"

For Each objFile In objFiles
If objFSO.GetFileName(objFile.Name) = xmlFileName Then
xmlFileName = objFSO.GetFileName(objFile.Name)
End If
Next

MsgBox xmlFileName

AtxtSIC = ""
txtSIC = ""
'-------------------Parsing XML file and fiend SIC,OQ and OUGP------------------
xmlDoc.async = False
xmlDoc.validateOnParse = False
xmlDoc.Load (xmlFileName)

xmlDoc.setProperty "SelectionLanguage", "XPath"

Set SIC = xmlDoc.selectNodes("//SupplierItemCode")
Set OQ = xmlDoc.selectNodes("//OrderedQuantity")
Set OUGP = xmlDoc.selectNodes("//OrderedUnitGrossPrice")

For Each txtSIC In SIC
AtxtSIC = AtxtSIC + txtSIC.Text + ","
MsgBox AtxtSIC
Next

AtxtSIC = Left(AtxtSIC, Len(AtxtSIC) - 1)

'-----------------Request Suplier Item Code from IS Pro ------------------------
Call db.Open("Provider='sqloledb';Data Source='Server';Initial Catalog='Pro_Sklad'", "sa", "")

sqlq = "select skln_cd, NmEi_QtOsn, skln_statrep from skln" + _
" left join sklnomei on skln_rcd=nmei_rcdnom" + _
" where nmei_cd=3 and skln_rcdgrp in (257,259,260,261,275)" + _
" and skln_statrep in(" + AtxtSIC + ")"

rec.Open sqlq, db
Open txtFileName For Output As #1

'-----------------Write in file -----------------------
If (SIC.Length = OQ.Length) And (OUGP.Length = OQ.Length) Then
For i = 0 To SIC.Length - 1
Print #1, rec!skln_cd & ";" & OQ(i).Text & ";" & OUGP(i).Text
Next
End If

Close #1
rec.Close
Set rec = Nothing
db.Close
Set db = Nothing
Set objFSO = Nothing
Set objFolder = Nothing
Set objFiles = Nothing
Set objFile = Nothing
End Sub

Разобрался почему вываливалась ошибка на втором условии. В директории были файлы с именем меньше чем n-13.

Помогите! Задача в следующем:

есть файл Meneger.xls в котором внесены некие данные, которые взяты из файлов лежащих в папке

в файле meneger.xls полная каша, наименование одно а ссылка на карточку с другим именем, так вот нужен макрос который бы переименовывал файлы в имена написанные в столбике В, обновил ссылки на ячейки в столбиках C,D,E , и в самом файле карточки изменил наименование карточки.

Для меня задача нереальная, но может кто осилит?

http://www.fayloobmennik.net/1075938
Архив папки, там всего 2 карточки, в настоящем архиве около 1000 карточек, вот поэтому и нужен макрос, имена со временем изменяют и в ручную такое не осилить, а так запустил макрос он переименовал что не совпадает, обновил ссылки и счастье!!!

Всем привет.
Добавил в свой проект две строчки

Код:
Dim DBConn As ADODB.Connection
Set DBConn = New ADODB.Connection

Call DBConn.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source='D:\trash\'; Extended Properties='DBASE IV',"",""")
DBConn.Execute ("create table REPORT (LCODE int(10), CODE int(16), SECTION int(20), KOL int(12), SUM double(30), PRTSH int(12))")

i = 0
While Not rec.EOF And SIC.Length - 1

DBConn.Execute ("Insert into REPORT Values(" + rec!skln_cd + ",'',''," + CIntOQ(i).Text * CInt(rec!nmEi_QtOsn) + "," + OUGP(i).Text + ",'')")
'Print #1, rec!skln_cd & ";" & CInt(OQ(i).Text) * CInt(rec!nmEi_QtOsn) & ";" & OUGP(i).Text

i = i + 1

rec.MoveNext

Wend

unit4

Цитата:

CIntOQ(i).Text

Вот это и не определено, тебе же компилятор это выделяет
Имелось ввиду видимо

Код:
CInt(OQ(i).Text)

AndVGri
вообще он мне выделял rec!skln_cd по этому понять и не мог, спасибо. Сейчас у меня другая ошибка Формат строки инициализации не соответствует спецификации OLE DB. Думаю это я нагуглю, но если есть желание, то можете помочь))
Вообще я создаю из xml dbf файл.

Добавлено:
Исправил

Добавлено:

Код:
Call DBConn.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source='D:\trash\'; Extended Properties='DBASE IV'")