Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание папки макросом с именем ячейки
 
#1
05.04.2019 22:55:21
Подскажите пожалуйста, есть макрос который создаёт папку при определённом условии и даёт ей имя из Листа1 (ячека N3)
но проблема в том, что если ячейка содержит текст с буквами Эстонского алфавита Ü, Ä, Ö, Š, Ž, Õ
то они заменяются в имени созданной папки на буквы U, A, O, S, Z, O
А этого делать нельзя так как затем макрос в эту папку сохраняет PDF файл и при этом происходит ошибка имени в сохраняемую папку.
Пожалуйста подскажите, возможно ли что бы буквы в названии папки не менялись, а сохранялись как в Эстонском оригинале Ü, Ä, Ö, Š, Ž, Õ ?
Возможно нужно как то подправить или дополнить макрос который создаёт папку?

Макрос который создаёт папку по условию:
Код
If Worksheets("SETTINGS").Cells(12, 15).Value = True Then
        papka = ThisWorkbook.Path & "\" & Trim(Sheets("ЛИСТ1").[N3].Value)
        If Dir(papka, vbDirectory) = "" Then MkDir papka
 
 
 
 
#2
05.04.2019 23:00:34
Можно.
Но писать долго - см. файл. Символы там правда не эстонские, но недалеко ушли :)
 
 
 
#3
05.04.2019 23:50:39
Hugo, Спасибо, посмотрел Ваш файл, но там для меня всё сложно, к сожалению ничего не понял.
Мне бы что попроще как можно обойти эту проблему.
Что самое интересное, что если папка создаётся макросом на флешку с форматом FAT32 то хоть и в имени папки всё равно меняются буквы Эстонские на Английские,
но сохранение в неё PDF файла макросом происходить без проблем. А на компьютере сохранение с жёстким диском в формате NTFS происходит ошибка из-за несовпадении имени папки.
Изменено: askgrupp - 05.04.2019 23:52:05
 
 
 
#4
06.04.2019 00:09:50
При сохранении фала PDF макросом в имени PDF фала буквы не меняются, PDF сохраняет с Эстонскими буквами
Так почему-же меняются буквы в имени папки? Непонятно
Вот макрос сохранения в PDF
Код
With Sheets("Лист1")
Sheets("Лист1").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Sheets("Лист1").[N3] & "\" & .[N2] & ".pdf"
End With
 
 
 
#5
06.04.2019 01:58:30
Возможно кто-то подскажет как создать формулу которая будет искать в тексте ячейки A1  буквы  Ü, Ä, Ö, Š, Ž, Õ
и менять уже в другой ячеке (например A2) cсоставив тот-же текст только с заменой букв:
Ü на U
Ä на A
Ö на O
Š на S
Ž на Z
Õ на O

Если такое возможно?
 
 
 
#6
07.04.2019 21:42:33
Вот нашёл вариант попроще:
Код
Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExW" (ByVal hwnd As LongPtr, ByVal pszPath As LongPtr, ByVal psa As Any) As Long
#Else
    Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExW" (ByVal hwnd As Long, ByVal pszPath As Long, ByVal psa As Any) As Long
#End If

' Проверяет наличие папки ExDir. Eсли нет, то папка создается (включая все вложенные)
' Возвращает путь к папке. При неудаче возвращает Empty
Function FolderTest(ByVal ExDir As Variant) As Variant
    Dim rc As Long
    rc = SHCreateDirectoryEx(ByVal 0&, StrPtr(ExDir), ByVal 0&)
    If rc <> 0 And rc <> 80 And rc <> 183 Then
        MsgBox "Нeудача при создании папки " & ExDir
    Else
        FolderTest = ExDir
    End If
End Function


Sub tt()
    Dim ans
    ans = FolderTest([a1].Value)
End Sub

Разберётесь? Главное дать функции строку в юникоде - в обоих моих примерах даётся строка с листа, но вероятно можно давать и кодом с использованием chrw(), но я не пробовал.
 
 
 
#7
07.04.2019 22:12:29
Эта проблематика обсуждалась здесь.
Владимир
 
 
 
Страницы: 1
Наверх