powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Копировать данные из одного excel файла в другой файл?
11 сообщений из 36, страница 2 из 2
Копировать данные из одного excel файла в другой файл?
    #36380078
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Поместить Numtranslate в модуль в PERSONAL.XLS
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380097
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Да, если файлы будете отдавать на сторону, то при изменении чисел пересчёт в строку работать не будет, если эта функция не будет в файле (или в PESONAL.XLS пользователя).
Вообще-то функция должна быть в файле, который загружается при старте Экселя из папки автозагрузки, у меня c:\Documents and Settings\юзер\Application Data\Microsoft\Excel\XLSTART\
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380112
NadyaP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121,
Глупый вопрос: как мне найти код этой функции? Я хотела добавить эту функцию хотя бы в нужный файл, но пока не нашла, что добавлять. Как можно посмотреть, может быть, путь к этой фунции в работающих файлах. Из похожего (название "функция перевода...")- есть файл с расширением .bas.
Что с ним делать - не знаю.
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380137
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот содержимое этого баса вероятно и есть код функции. Его можно импортнуть в редактор ВБА или просто открыть блокнотом и скопировать текст (там в начале лишние строки бывают).
Начинаться код должен с строки Public Function Numtranslate(переменная) As String
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380150
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Или давай сюда любой файл с функцией, можно в нём всё содержимое поудалять (целиком с листами, один чистый новый сперва добавь), глянем, и наверняка кому-нибудь пригодится.
У меня кстати тоже такая функция есть, переделал из русской в национальные, аж 5 штук - разных родов, вещественные, денежные, с скобками, без скобок...)
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380193
NadyaP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121,
в блокноте посмотрела - это она.

Если кому-нибудь будет полезно, пожалуйста, - мне очень нравится эта функция.
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380230
NadyaP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
вот она:

'Функция разработана Власовым Игорем
'для всех желающих без каких бы то ни было претензий со стороны автора.
'Автор разрешает использовать данный продукт в любых целях,
'кроме нанесения вреда другим людям и животным.
'Автор не несет никакой ответственности за правильное
'и неправильное употребление данного "продукта".
'
'


Public Function NumTranslate(Refer As Range, CHR_1 As Boolean, WordFOR_1 As String, WordFOR_2_3_4 As String, WordFOR5 As String, _
Optional WrdFOR_1 As String, Optional WrdFOR_2_3_4 As String, Optional WrdFOR5 As String) As String
Attribute NumTranslate.VB_ProcData.VB_Invoke_Func = " \n14"

Dim Word(3, 9) As String
Dim Wrd(9) As String * 12
Dim stroka, Strich As String
Dim volume, number As Double
Dim L_nu, L_num As Integer
Dim slov, sl_v1, strMsg As String
Dim prov As Boolean


'Заполнение массива
Word(1, 1) = "од": Word(2, 1) = "десять": Word(3, 1) = "сто"
Word(1, 2) = "дв": Word(2, 2) = "двадцать": Word(3, 2) = "двести"
Word(1, 3) = "три": Word(2, 3) = "тридцать": Word(3, 3) = "триста"
Word(1, 4) = "четыре": Word(2, 4) = "сорок": Word(3, 4) = "четыреста"
Word(1, 5) = "пять": Word(2, 5) = "пятьдесят": Word(3, 5) = "пятьсот"
Word(1, 6) = "шесть": Word(2, 6) = "шестьдесят": Word(3, 6) = "шестьсот"
Word(1, 7) = "семь": Word(2, 7) = "семьдесят": Word(3, 7) = "семьсот"
Word(1, 8) = "восемь": Word(2, 8) = "восемьдесят": Word(3, 8) = "восемьсот"
Word(1, 9) = "девять": Word(2, 9) = "девяносто": Word(3, 9) = "девятьсот"

Wrd(1) = "одиннадцать"
Wrd(2) = "двенадцать"
Wrd(3) = "тринадцать"
Wrd(4) = "четырнадцать"
Wrd(5) = "пятнадцать"
Wrd(6) = "шестнадцать"
Wrd(7) = "семнадцать"
Wrd(8) = "восемнадцать"
Wrd(9) = "девятнадцать"

On Error GoTo errorlabel
prov = True
stroca = ""

volume = Refer.Value

If volume > 1000000000 Then
MsgBox "Больше 999999999 перевести не могу", 64, "Внимание"
Exit Function
Else
volume = Abs(volume)
volume = Format(volume, "########0.00")
drob = (Format((volume - Int(volume)), "0.00") * 100)
number = Int(volume)
prov = False

L_nu = Val(Right(Str(number), 2))
L_num = Val(Right(Str(number), 1))

If L_nu > 10 And L_nu < 20 Then
slov = " " + WordFOR5
Else
Select Case L_num
Case 1
slov = "ин " + WordFOR_1
Case 2
slov = "а " + WordFOR_2_3_4
Case 3, 4
slov = " " + WordFOR_2_3_4
Case Else
slov = " " + WordFOR5
End Select
End If
L_nu = Val(Right(Str(drob), 2))
L_num = Val(Right(Str(drob), 1))

If L_nu > 10 And L_nu < 20 Then
sl_v1 = WrdFOR5
Else
Select Case L_num
Case "1"
sl_v1 = WrdFOR_1
Case "2", "3", "4"
sl_v1 = WrdFOR_2_3_4
Case Else
sl_v1 = WrdFOR5
End Select
End If
End If
'*******************
Chislo = Str(number)
GoSub Work3:

Chislo = Str(Int(number / 1000))
If Chislo >= 1 Then

L_nu = Val(Right(Str(Chislo), 2))
L_num = Val(Right(Str(Chislo), 1))
If L_nu > 10 And L_nu < 20 Then
Strich = " тысяч"
Else
Select Case L_num
Case "1"
Strich = "на тысяча"
Case "2"
Strich = "е тысячи"
Case "3", "4"
Strich = " тысячи"
Case Else
Strich = " тысяч"
End Select
End If

stroca = Strich + stroca
GoSub Work3:
End If
'------------------------------

Chislo = Str(Int(number / 1000000))
If Chislo >= 1 Then
L_nu = Val(Right(Str(Chislo), 2))
L_num = Val(Right(Str(Chislo), 1))

If L_nu > 10 And L_nu < 20 Then
Strich = " миллионов"
Else
Select Case L_num
Case "1"
Strich = "ин миллион"
Case "2"
Strich = "а миллиона"
Case "3", "4"
Strich = " миллиона"
Case Else
Strich = " миллионов"
End Select
End If

stroca = Strich + stroca
GoSub Work3:
End If


stroca = stroca + slov + " " + IIf(drob < 9, "0" + Trim(Str(drob)), Str(drob)) + " " + sl_v1
If CHR_1 Then
Dim kl_s As String
Dim dl_s As Integer
dl_s = Len(Trim(stroca))
kl_s = Mid(Trim(stroca), 1, 1)
stroca = UCase(kl_s) + Mid(Trim(stroca), 2, dl_s)
Else
End If
NumTranslate = stroca
Exit Function
Work3: ' подрограмма обработки троек чисел
'*****************
For i = 1 To 3
L_nu = Val(Right(Chislo, 2))
L_num = Val(Left(Right(Chislo, i), 1))
If L_nu > 10 And L_nu < 20 And i = 1 Then
stroca = " " + Wrd(L_num) + stroca
i = 2
GoTo jump:
Else
stroca = " " + Word(i, L_num) + stroca

End If
jump:
Next i: Return
'******************

errorlabel:
If prov Then
strMsg = "В данную ячейку необходимо записать число" & Chr(13)
strMsg = strMsg & " Например 1234,23 , исправте запись и запустите" & Chr(13)
strMsg = strMsg & " сначала"
MsgBox strMsg, 64, " Ошибка"
Else
strMsg = "Возникла ошибка: " & Err.Description & Chr(13)
strMsg = strMsg & " номер: " & Err.number
MsgBox strMsg, 64, " Ошибка"

End If
End Function
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380900
NadyaP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121, добавила файл с функцией в ...Microsoft\Excel\XLSTART\ и получила интересный результат - при запуске Excel на первую страницу Excel попадает текст этой функции.

В итоге - записала в основной файл, а в файле который получается (Счет) использую фунцию с ссылкой на исходный файл. Пока работает.

Огромное спасибо.
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380948
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121
Вообще-то функция должна быть в файле, который загружается при старте Экселя из папки автозагрузки, у меня c:\Documents and Settings\юзер\Application Data\Microsoft\Excel\XLSTART\ - файле *.xls
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36380954
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Точнее - Поместить Numtranslate в модуль в PERSONAL.XLS (файл без листов, т.е. фактически невидимый), который уже есть в папке автозагрузки. Если его там нет, то создать так - записать мастером любой макрос, при создании указать как файл для размещения персональную книгу макросов. Затем через редактор добавить туда в модуль свою функцию, заодно удалить этот бестолковый макрос.
...
Рейтинг: 0 / 0
Копировать данные из одного excel файла в другой файл?
    #36381980
NadyaP
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Я делала тоже самое, только поместила функцию не в PERSONAL.XLS , а в исходный файл.
Спасибо, попробую записать в PERSONAL.XLS
...
Рейтинг: 0 / 0
11 сообщений из 36, страница 2 из 2
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Копировать данные из одного excel файла в другой файл?
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]