Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 След.
Вставка текста из txt в ячейку
 
Цитата
valentinM написал:
Добрый день!
Искал повсюду ответ на простой вопрос и очень странно - не нашёл!
Плохо искали в каждой книге по VBA есть примеры работы с текстовыми файлами.
Если лень читать книги, то вот Вам пример разберетесь самостоятельно (это всего 1 вариант из десятков возможных).
Удачи
Код
Sub ReadTextFileFSO()
'''Чтение всего текстового файла
Dim objFile As Object, objFS As Object
Dim strFullFileName As String '' полный путь к файлу
Dim strRead As String
strFullFileName = "D:\Users\TSN\Desktop\WWWList.txt"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.OpenTextFile(strFullFileName, 1, True)
    strRead = objFile.ReadAll ''' копируем
              objFile.Close
   ActiveCell.Value = strRead ''' вставляем
Set objFS = Nothing: Set objFile = Nothing
strRead = vbNullString
End Sub
Изменено: TSN - 26 Май 2017 15:40:09
Переменная не исчезающая при закрытии книги.
 
1. Можно создать лист Sheet.Visible = xlVeryHidden  супер скрытым и загружать туда данные, после открытия получать их оттуда.
2. Можно выгружать данные в другой файл например в тектовый *.txt, в файл *.xml и так далее
Макрос вставки в текущую ячейку ссылки на файл
 
Цитата
Sege написал:
Можно чтобы ссылка вставлялась в ТЕКУЩУЮ активную ячейку?
Измените процедуру на такую, будет вставлять в выделенную ячейку а также в выделенные ячейки
Код
Sub OpenDialog()
''' Процедура формировани гиперссылки на файл
Dim strAddres As String, Vl
strAddres = fnOpenTextFile
If Len(strAddres) > 0 Then
    For Each Vl In Selection  
      Vl.Value = "=HYPERLINK(" & Chr(34) & strAddres & Chr(34) & "," & Chr(34) & strAddres & Chr(34) & ")"
    Next
End If
End Sub
Изменено: TSN - 26 Май 2017 13:44:34
Макрос вставки в текущую ячейку ссылки на файл
 
Ловите решение, тестируйте. В прикрепленном файла также есть код.
Диалог с пользователем специально выведен в отдельную функцию с целью использования ее в других задачах.
Код
Option Explicit

Sub OpenDialog()
''' Процедура формировани гиперссылки на файл
Dim strAddres As String
strAddres = fnGetOpenFilename
If Len(strAddres) > 0 Then
''' Загрузка выполняется в текущую книгу листа1 ячейки А2
  With ThisWorkbook
    With .Sheets("Лист1")
        .Range("A2") = "=HYPERLINK(" & Chr(34) & strAddres & Chr(34) & "," & Chr(34) & strAddres & Chr(34) & ")"
    End With
  End With
End If
End Sub

Public Function fnGetOpenFilename(Optional sTitle As String = "Выбор файла для формирования гиперссылки", _
                                  Optional MultiSelectFiles As Boolean = False)
''' Функция диалога с пользователем выбора файла _
 по умолчанию выбор любого формата файла, выбор только одного файла
  fnGetOpenFilename = Application.GetOpenFilename _
                  ("Любые файлы (*.*),*.*", , sTitle, , MultiSelectFiles)
End Function
Изменено: TSN - 26 Май 2017 13:16:53
сбор данных с файлов, заполнение сводной таблицы с разных файлов
 
Правила форума  
2.2. Опишите максимально подробно вашу задачу
и желаемый результат. Желательно уточнить вашу версию Excel.
   2.3. Приложите файл(ы) с примером (общим весом не более 100 Кб) в реальной структуре и форматах данных того, что есть сейчас и того, что хотелось бы на выходе.
Изменено: TSN - 23 Май 2017 16:46:05
VBA не видит если дата расчитана формулой
 
Измените вашу процедуру на такой вариант и будет Вам счастье
Код
Sub ZapolnitDanie2()
Dim X As String, X1 As Date, X2 As Range, X3 As Integer, X4 As Integer
Dim rngBase As Range, rngIcells As String
'_______________________________ на какую дату делаем заполнение ___________________________________________
X1 = Range("S6").Text 'берем дату для определения заполняемой колонки
Set X2 = Range("A4:G4")
For Each vl In X2.Cells
  If vl.Text = X1 Then vl.Select: Exit For 'выделяем и выходим из цикла
Next
End Sub
Условное форматирование или макрос если ячейка не содержит, Покрасить ячейки с непечатными символами
 
замените в коде
Код
objRegExp.Pattern = "[^А-я0-9_\,\ \-]"
на
Код
objRegExp.Pattern = "[^А-я0-9_\,\ \-\/\\\[]"
Условное форматирование или макрос если ячейка не содержит, Покрасить ячейки с непечатными символами
 
Еще один вариант решения
Процедура анализирующая диаппазон ячеек активной книги. активного листа (ActiveWorkbook.ActiveSheet).
Анализируемый диаппазон 20 ячеек в данном случае при желании можно менять .Range("A1:A20") или .Range("A1:B20") или .Range("A1:H2000") и тд.
Также можно использовать .Range("A1").CurrentRegion и ActiveSheet.UsedRange или Selection всё зависит от поставленных задач.
Тестируйте.
Код
Sub Покрасить_ячейки_с_непечатными_символами()
Dim objRegExp, Vl
Set objRegExp = CreateObject("VBScript.RegExp") 
objRegExp.Global = False
objRegExp.IgnoreCase = True            ' Игонорируем регистр
objRegExp.Pattern = "[^А-я0-9_\,\ \-]" ' Не входит в шаблон (сравниваемый текст) "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩ­ЪЫЬЭЮЯ0123456789 ._-"
With ActiveWorkbook
  With .ActiveSheet
      For Each Vl In .Range("A1:A20")  ''' Анализ 
        If objRegExp.test(Vl.Value) Then Vl.Interior.Color = 255
      Next
  End With
 End With
Set objRegExp = Nothing
End Sub
Изменено: TSN - 23 Май 2017 15:13:18
Простое двойное условие, если активная ячейка пустая
 
Вот реализация Вашего желания в реальности пользуйтесь, тестируйте, могут быть баги писал в блокноте. Логику можно еще более навернуть, возможности VBA позволяют.  :)
Обратите внимание процедура заточена под активное приложение Excel и активный лист (With ActiveWorkbook,  With ActiveSheets)  8)
Код
Sub Удалить_проект_Несколько()
Dim Vl, intCount As Long, intTest
With ActiveWorkbook
  With ActiveSheets
    If Intersect(ActiveCell, Columns(2)) Is Nothing Then ''' Если выделение вне столбца "Б"
       MsgBox "Выберете ячейку с названием проекта в колонке B и повторите действие еще раз", 48
    Else
      For Each Vl In Selection  ''' Анализ количества выделенных ячеек только столбца "Б"
        intCount = intCount + 1
        If Not IsEmpty(Vl.Value) And Vl.Column = 2 Then intTest = intTest + 1
      Next
      Select Case intCount
      Case Is = 1 ''' стандартная обработка одной ячейки
          Select Case intTest
            Case Is = 0: MsgBox "Данные о проектах полностью удалены", 64
            Case Else
               If MsgBox("Данные этого проекта будут полностью удалены. Продолжить?", 4) = 6 Then ActiveCell.Value = Empty
          End Select
      Case Else   ''' расширенная обработка нескольких ячеек
        Select Case intTest
          Case Is = 0: MsgBox "Данные о проектах полностью удалены", 64
          Case Else
             If MsgBox("Общее количество выделенных ячеек проектов колонки Б составило " & intTest & "штук. Продолжить?", 4) = 6 Then
                For Each Vl In Selection ''' Удаляем выделенные ячейки только столбца "Б"
                    If Not IsEmpty(Vl.Value) And Vl.Column = 2 Then Vl.Value = Empty
                Next
             End If
          End Select
      End Select
    End If
  End With
 End With
End Sub
VBA готовые классы для создания древовидной структуры
 
dsb75, Ваш труд впечатляет, конечно возможностей Collection / Dictionary / NET 2.0 (System.Collections.ArrayList) вполне хватает. Но с целью изучения Вашего кода и самообразования в мире VBA  в ближайший проект с удовольствием добавлю класс PerfectTree.

Большое спасибо за труд.

Подсчет количества числовых строк в массиве
 
Цитата
Tidus написал:
А если всё делать в памяти внутри кода, то к коде из 1000 строк гораздо сложнее найти ошибку в формулах, чем в таблице, где все данные на виду.
Уважаемый Tidus касательного вашего примера, код который выполняет действия согласно Вашего примера менее 1000 строк, конечно его можно усложнить при желании.
Код
Sub КоличествоСтрок_с_Числами()
Dim rng As Range, vl, temp, i  As Long, Summ As Long
Const ClmnCount As Long = 3 'констатнта количество столбцов (полей) в массиве
With ThisWorkbook
  Set rng = .Sheets("Лист1").Range("b4:b14") 'диаппазон первого поля массива
  For Each vl In rng
    For i = 0 To ClmnCount - 1 'анализ массива (поиск чиловых значений)
      temp = .Sheets("Лист1").Cells(vl.Row, vl.Column + i).Value
      If Not IsEmpty(temp) Then If IsNumeric(temp) Then Summ = Summ + 1: Exit For
    Next i
  Next
End With
Set rng = Nothing 'финальная стадия. очистка памяти вывод результата
MsgBox "Результат = " & Summ, vbInformation, "ОТВЕТ"
End Sub

Изменено: TSN - 22 Май 2017 17:05:16
Выбор из таблиц значений в зависимости от номера строки
 

Сори недосмотрел  :)

Все равно предложу альтернативу  ;)

Дело в том, что ReDim Preserve arr(1 To 4, 1 To h) внутри цикла замедляет выполнение процедуры. Для быстродействия лучше вычислить размер итогового массива до цикла (конечно если это возможно), так будет быстрей работать, конечно при цикле в 491 строку и 4 поля это незаметно, но если запустить обработку скажем 900000 строк и 25 полей массива ReDim Preserve однозначно проявит себя. 8)

Код
Option Explicit

Sub TempCopy11()
Dim arr(), arrItog()
Dim maxRow As Long, maxClmn As Long
Dim i As Long, x As Long, n As Long

With ThisWorkbook
    ''' Загрузка массива с шагом в 10 строк
    arr = .Sheets("Лист1").Range(.Sheets("Лист1").Cells(1, 1).End(xlToRight), .Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp)).Value
    maxRow = UBound(arr, 1): maxClmn = UBound(arr, 2)
    ReDim arrItog(1 To maxRow / 10 + 1, 1 To maxClmn)
    
    For i = 1 To maxRow Step 10
    n = n + 1
      For x = 1 To maxClmn
         arrItog(n, x) = arr(i, x)
      Next x
    Next i
    
    ''' Выгрузка массива ответа в два разных места
    With Sheets("Лист2")
      .Range("A1").Resize(UBound(arrItog, 1), UBound(arrItog, 2)) = arrItog
    End With
    On Error Resume Next
    .Worksheets.Add.Name = "List12345"
    With Sheets("List12345")
      .Range("A1").Resize(UBound(arrItog, 1), UBound(arrItog, 2)) = arrItog
    End With
    Erase arr: Erase arrItog
End With
End Sub
Выбор из таблиц значений в зависимости от номера строки
 
Для ознакомления с возможностями VBA, VBA Excel.
Еще несколько способов копирования данных (таблиц и т.д.). Процедура написана под ваш пример сделать копию таблицы.
Код
Sub TempCopy()
Dim objTemp As Object
Dim maxRow As Long, maxClmn As Long

With ThisWorkbook
  With Sheets("Лист1")
    ''' Вариант 1
    Set objTemp = .Range(.Cells(1, 1).End(xlToRight), .Cells(Rows.Count, 1).End(xlUp))
    maxRow = objTemp.Rows.Count
    maxClmn = objTemp.Columns.Count
    objTemp.Copy
'    1.1
    .Paste (.Range(.Cells(1, (maxClmn * 2) + 2), .Cells(maxRow, (maxClmn * 2) + 2)))
'    1.2
    .Paste (Sheets("Лист2").Range(Sheets("Лист2").Cells(1, 1), Sheets("Лист2").Cells(maxRow, 1)))
    Set objTemp = Nothing
    
    ''' Вариант 2 - Выгружаем (копия массива) данные на лист
    Dim arr
    arr = .Range(.Cells(1, 1).End(xlToRight), .Cells(Rows.Count, 1).End(xlUp)).Value
'    2.1
     With Sheets("Лист3")
       .Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
     End With
'     2.2
     Worksheets.Add.Name = "List12345"
     With Sheets("List12345")
       .Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
     End With
    Erase arr
  End With
End With
End Sub


Вывод данных из Excel текстом
 
Код
Sub Упрощенный_пример()
  Dim sName As String, F, M
  Dim arr(), i As Long, x As Long
  With ThisWorkbook
      sName = .Sheets("Лист1").Range("B1").Value: arr = .Sheets("Лист1").Range("A2:N5").Value
  End With
  F = FreeFile
  Open ThisWorkbook.Path & "\Запись.txt" For Output As #F
  Print #F, Spc(10); sName
  Print #F, ""
  For i = 1 To UBound(arr, 1)
    Print #F, ""
      For x = 1 To UBound(arr, 2): Print #F, arr(i, x) & " ";: Next x
    Next i
  Close #F
End Sub

Простой пример записи данных с листа в текстовый файл без форматирования. При желании можно формировать отчеты в любые форматы файла (*.txt; *.doc; *.xls; *.csv; *.html) и так даллее.
Почитайте внимательно правила форума и подготовьте вопрос согласно требований, правила не даром написаны.
Вывод данных из Excel текстом
 
Цитата
Валерик написал: Над Вами тоже все стебаются, когда Вы что-то не знаете и просите помощи?
Уважаемый я не стебаюсь. Ваш вопрос привел меня к такому ответу.
Если вопрос будет конкретней то ответ будет конкретней.
Вывод данных из Excel текстом
 
Цитата
vbandurko написал:
Требуется ежедневно выуживать
Для этого лучше подойдет удочка, спининг или сеть
Цитата
vbandurko написал:
Далее по моей задумке нужно присвоить переменной все эти данные с помощью значков & и оператора Chr(10)
Лучше с помощью крючков.
:D :D :D
Как производить арифметические действия с адресом ячейки в макросе
 
Так будет работать
Код
Sub Макрос()
Dim sFind, iRange, adr
With ThisWorkbook
  With Лист1
  sFind = .Cells(2, 2).Value                      '''ссылка на ячейку В2 со занчением для поиска
    With .Range(.Cells(1, 1), .Cells(100, 1))     ''' поиск в заданном диаппазоне А1:А100
      Set iRange = .Find(What:=sFind, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) '''ссылка на найденую ячейку со занчением
      If Not iRange Is Nothing Then
        MsgBox "адрес " & iRange.Address & vbCrLf & "значение = " & iRange.Value
      Else
        MsgBox "Поиск не дал результат"
      End If
    End With
  End With
End With
End Sub
Как производить арифметические действия с адресом ячейки в макросе
 
Посмотрите мой вариант, написан под ваш пример.
Код
Sub Макрос()
Dim sFind, iRange, adr
With ThisWorkbook
  With Лист1
  sFind = .Cells(2, 2).Value                      '''ссылка на ячейку В2 со занчением для поиска
    With .Range(.Cells(1, 1), .Cells(100, 1))     ''' поиск в заданном диаппазоне А1:А100
      Set iRange = .Find(What:=sFind, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) '''ссылка на найденую ячейку со занчением
      adr = iRange.Address                        ''' переменная содержит адрес ячейки
    End With
  End With
End With
End Sub
Как вставить таблицу из pdf в excel
 
Цитата
JeyCi написал:
с + разобраться несложно: делаю найти-заменить +(с пробелом) на просто +, итог попадает в одну ячейку,НО вот с - (минусовые) изменения - так не работает, т к по др столбцам обозначаются ---- (нет значений) данныеребята, помогите please решить такую проблему -
Посмотрев структуру файла с примером, такую проблему можно решить обычной хитростью.
1. найти-заменить ---- на xxxx
2. найти-заменить - (с пробелом) на -
3.  найти-заменить xxxx на ----
Надеюсь помог.
Кнопка на два действия, Ошибка в скрипте
 
Отсутствует NEXT в первой части
Код
If CommandButton1.Caption = "Скрыть" Then
        Application.ScreenUpdating = False                              'отключаем обновление экрана для ускорения
    For Each cell In ActiveSheet.UsedRange.Rows(1).Cells            'проходим по всем ячейки первой строки
        If cell.Value = "z" Then cell.EntireColumn.Hidden = True        'если  ячейке z - скрываем столбцы
        Application.ScreenUpdating = True
    NEXT     
        CommandButton1.Caption = "Показать"
 
Нужно подправить код на вставку со смещением по строкам
 
Код
Sub Макрос()
dim vl
For Each vl In Selection
''' смещение на 2 вниз и 5 влево от выделенной ячейки (дипазона)
   vl.Offset(2, -5).Value = vl.Value
Next
End Sub
Изменено: TSN - 29 Авг 2016 06:25:20
Как задать массив с помощью выделения в конкретном случае, Не получается взять данные со страницы через Selection
 
Привет форумчане  :)
Давненько я здесь не был  :(

Не совсем понял суть просьбы, но все же смогу на простом примере показать как выполнить задачу
Цитата
RomanDor написал:
Просто нужно сделать так, чтобы в выделении значения округлялись с заданной точностью
Алгоритм округления и контроля 100% допишите самостоятельно. я выложу пример работы с Range и массивом.
Код
Sub Primer()
Dim arr(), rng As Range, Vl As Object
Dim iRound As Integer, i As Long, n As Long
Dim iTemp

With ThisWorkbook
    iRound = Application.InputBox("Введите количество значений после запятой:", , , , , , , 1)
    If iRound = 0 Then
      iTemp = MsgBox(prompt:="Количество значений после запятой равно 0." & Chr(13) & "Продолжить выполнение ?", Buttons:=324)
      If iTemp = 7 Then Exit Sub
    End If

    On Error Resume Next
    Set rng = Application.InputBox("Укажите диапазон с которым необходимо работать." _
            & Chr(13) & "Обязательный параметр.", "Выбор диапазона (можно мышкой)", , , , , , 8)
    ''' Выход при нажатии кнопки отмена
    If rng Is Nothing Then
        MsgBox "Отменено пользователем." _
        & Chr(13) & "Завершение работы.", vbInformation, "Стоп !": Exit Sub
    End If
    On Error GoTo 0
    
    
    ''' 1 пример работы с Range (вычисления проводятся по каждой ячейке в цикле _
                                с возвратом значения в ячейку)
    '''' способ выполнения более медленный чем массивы но имеет ряд преимуществ
    'For Each Vl In rng
    '  If IsNumeric(Vl) Then                                 ''' проверка числового значения
    '      iTemp = Vl.Value: Vl.Value = Round(iTemp, iRound) ''' выполняем округление до заданного знака
    '  End If
    'Next
      
      
    ''' 2 пример работы с массивом (вычисления проводятся в цикле со всеми значениями _
                                   с возвратом всех значений сразу в диапазон выделенных ячеек)
    '''  вычисления в десятки раз быстрей чем рендж особенно при больших обьемах данных
    arr = rng.Value2
    For i = 1 To UBound(arr, 1)
      For n = 1 To UBound(arr, 2)
        iTemp = arr(i, n): arr(i, n) = Round(iTemp, iRound) ''' выполняем округление до заданного знака
      Next n
    Next i
    ''' выгружаем ответ из массива в выделенный диаппазон
    rng.Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
  
End With
End Sub
Удачи. :D
Как с помощью макроса начать новую строку в одной и той же ячейке
 
Цитата
ZavHoz1984 написал: Создаю макрос, который поможет мне написать много однообразных макросов, в которых меняются лишь некоторые значения
Яркое желание  :D. А одну функцию которая получает на входе некоторое значение написать не проще ли.
Как отменить показ Msgbox из другой процедуры при ее запуске
 
Цитата
Александр Медведев написал: В конце процедуры Итого я сделал cns = 0. Это то же, что и сброс в False или другое имеется ввиду.
Именно об этом я говорил. Лишнее действие. лишняя строка кода. Представьте, что у Вас пару десятков флагов (Boolean) объявленных как глобальные переменные и пару десятков процедур связанных в одной программе через эти флаги. За таким стадом флагов устанешь следить, забыл сбросить получил неожиданный результат. и т.д. Хотя без глобальных переменных тоже нельзя. Как то так.  :)
Как отменить показ Msgbox из другой процедуры при ее запуске
 
Вариант vikttur более приемлем т.к. отпадает необходимость отслеживать глобальную переменную Public cns As Boolean и при необходимости сбрасывать в False. Аргумент  bFlag As Boolean сам перейдет в False после завершения процедуры, что позволяет лучше контролировать действия программы при повторном вызове. Вам остается только передать нужный аргумент при запуске процедуры Call AAA(True) или Call AAA(False).
Есть еще один вариант сделать аргумент опциональным и присвоить ему значение по умолчанию. Тогда можно обращаться к процедуре без передачи аргумента если нужно выполнение задачи по умолчанию и передавать аргумент только при необходимости изменить умолчание.
Код
Sub Расчет1(): Call AAA(): End Sub
Sub Расчет2(): Call BBB(True): End Sub
 
Sub AAA(Optional bFlag As Boolean = False)
Dim x As Double
    x = 1: y = x + 1
    If bFlag Then MsgBox y
End Sub
 
Sub BBB(Optional bFlag As Boolean = False)
Dim x As Double
    x = 2: y = x + 2
    If bFlag Then MsgBox y
End Sub
Изменено: TSN - 17 Сен 2015 12:10:06
Ошибка "argument not optional"
 
Процедура Back принимает четыре аргумента указанные в скобках после названия (channel as string, selection as string ....).
Ошибка означает, что Вы пытаетесь запустить Back без передачи аргументов, что неприемлемо.
Решение: 1. Запуск CALL Back в такой форме CALL Back ("Пример1", "Пример2", "Цена вопроса", "Еще чтото").
Таким образом запуск процедуры  Back будет выполнен успешно т.к. она получила все объявленные аргументы.
2. Второй вариант сделать аргументы опциональными и присвоить им значения по умолчанию.

Что касается тегов VBA не причем. В момент когда создаете сообщение на форуме и хотите вставить код, часть кода нужно нажать Кнопка форматирования кода <...> после чего вставить код в форму с серым фоном.
Изменено: TSN - 17 Сен 2015 08:45:38
Скопировать строки с пустими ячейками
 
Бочка варенья и ящик печенья это хорошо, только боюсь потом в двери не войду.  :)
Процедуру доработать до желаний ТС не проблема, только на работе завал начался, отвлекаться особо не получается.  :(
Скопировать строки с пустими ячейками
 
Цитата
Z написал: Однако - primer.XLSX - явный намек, что макросом и не пахнет. С "0" делать за вас?
Это продолжение темы http://planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=69336&TITLE_SEO=69336-skryt-strok...
Макросами там пахнет, только аппетит у ТС увеличивается постоянно.
Можно ли сохранить файл при закрытии с некими параметрами?
 
Попробуйте так, немного подредактированный код от JayBhagavan
Адрес сохранения "рабочий стол \отчет", с проверкой папки на наличие
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim WshShell As Object, oFS As Object
Dim target_path As String
    Set WshShell = CreateObject("WScript.Shell")
    Set oFS = CreateObject("Scripting.FileSystemObject")
    target_path = WshShell.SpecialFolders("Desktop") & "Отчет\" 'на рабочий стол в \отчет
    If Not oFS.FolderExists(target_path) Then 'проверка на наличие папки
        MsgBox "Папка " & Chr(34) & target_path & " не существует, создайте папку." & vbCrLf & _
               "Копия файла не сохранена.", 16
        Cancel = True
        Exit Sub
    End If
    With ActiveSheet
        target_path = target_path & .Range("B1").Value & "_" & .Range("A1").Value & "_" & .Range("C1").Value & ".xls"
    End With
    Me.SaveCopyAs target_path
End Sub 

Jonny код следует оформлять тегом. - Это касается поста №21

Код Михаила Лебедева
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.SaveAs Filename:=Range("Имя"), _
        FileFormat:=xlExcel12, CreateBackup:=False
End Sub
Процедура ссылается на именованный диапазон "Имя" = ячейка "В3".
FileFormat:=xlExcel12 -  формат Ексель 2010.  Лучше заменить на FileFormat:=xlNormal - так будет работать в любой версии.
Изменено: TSN - 16 Сен 2015 16:28:49
Можно ли сохранить файл при закрытии с некими параметрами?
 
Что именно не работает ?
Страницы: 1 2 3 4 5 6 7 След.
Наверх