Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Заполнить google sheets данными из excel, при помощи vba - Страница 2 - Мир MS Excel

  • Страница 2 из 2
  • «
  • 1
  • 2
Модератор форума: _Boroda_, китин, DrMini  
Заполнить google sheets данными из excel, при помощи vba
airatgimranoff Дата: Вторник, 13.06.2023, 18:52 | Сообщение № 21
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

2021
TvoiExcel,
VBA часть:
[vba]
Код
Sub sendPOST()

Const webAppId As String = "********" 'Id веб-приложения, доступного всем после авторизации

Dim httpRequest As Object 'MSXML2.XMLHTTP
Dim URL As String
Dim requestBody As Variant
Dim row As Integer, col As Integer

Dim rng As Range
Set rng = ActiveSheet.Range(Cells(1, 1), Cells(23, 14)) 'выбираем любой диапазон на активном листе

Dim content as String
content = ToArrJSON(rng)

requestBody = "&content=" & EncodeUriComponent(content)

URL = "https://script.google.com/macros/s/" & webAppId & "/exec"

Set httpRequest = CreateObject("MSXML2.XMLHTTP")
httpRequest.Open "POST", URL, False
httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpRequest.Send requestBody

Set httpRequest = Nothing

End Sub
[/vba]

[vba]
Код
'конвертируем Кириллицу
Public Function EncodeUriComponent(str)
Static objHtmlfile As Object
If objHtmlfile Is Nothing Then
Set objHtmlfile = CreateObject("htmlfile")
objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
End If
EncodeUriComponent = objHtmlfile.parentWindow.encode(str)
End Function
[/vba]

[vba]
Код
'заворачиваем данные из диапазона rng в JSON
Public Function ToArrJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToArrJSON = CVErr(xlErrNA)
Exit Function
End If

Dim dataLoop, headerLoop As Long
' Get the first row of the range as a header range
Dim headerRange As Range: Set headerRange = Range(rng.Rows(1).Address)

Dim colCount As Long: colCount = headerRange.Columns.Count

Dim json As String: json = "["

For dataLoop = 0 To rng.Rows.Count
' Include the first header row as well
If dataLoop > 0 Then
' Start data row
Dim rowJson As String: rowJson = "["

For headerLoop = 1 To colCount
rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
rowJson = rowJson & ","
Next headerLoop

' Strip out the last comma
rowJson = Left(rowJson, Len(rowJson) - 1)

' End data row
json = json & rowJson & "],"
End If
Next

' Strip out the last comma
json = Left(json, Len(json) - 1)

json = json & "]"

ToArrJSON = json
End Function
[/vba]

Google Script часть:

[vba]
Код
function doPost(e) {

let ss = SpreadsheetApp.openById('************'); //id файла
let sheet = ss.getSheetByName('*******');//имя листа

let content = e.parameter.content;
let parsedContent = JSON.parse(content);
let ResultArray = [parsedContent[0].slice()];

for (let i=1; i<parsedContent.length; i++) {
ResultArray.push( parsedContent[i].slice() )
}

let needRows = ResultArray.length;
let needCols = ResultArray[0].length;

sheet.getRange(1, 1, needRows, needCols).setValues(ResultArray)
}
[/vba]

Сохраняем. Делаем развёртывание. У меня всё работает. Присваиваем в VBA переменной webAppId нужный адрес Вэб-Приложения (после развёртывания копируем с экрана) .

В прикреплённом скрине все подключения, которые у меня есть в Tools => References =>
К сообщению приложен файл: 4872605.png (123.0 Kb)


Сообщение отредактировал Serge_007 - Среда, 14.06.2023, 09:34
 
Ответить
СообщениеTvoiExcel,
VBA часть:
[vba]
Код
Sub sendPOST()

Const webAppId As String = "********" 'Id веб-приложения, доступного всем после авторизации

Dim httpRequest As Object 'MSXML2.XMLHTTP
Dim URL As String
Dim requestBody As Variant
Dim row As Integer, col As Integer

Dim rng As Range
Set rng = ActiveSheet.Range(Cells(1, 1), Cells(23, 14)) 'выбираем любой диапазон на активном листе

Dim content as String
content = ToArrJSON(rng)

requestBody = "&content=" & EncodeUriComponent(content)

URL = "https://script.google.com/macros/s/" & webAppId & "/exec"

Set httpRequest = CreateObject("MSXML2.XMLHTTP")
httpRequest.Open "POST", URL, False
httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpRequest.Send requestBody

Set httpRequest = Nothing

End Sub
[/vba]

[vba]
Код
'конвертируем Кириллицу
Public Function EncodeUriComponent(str)
Static objHtmlfile As Object
If objHtmlfile Is Nothing Then
Set objHtmlfile = CreateObject("htmlfile")
objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
End If
EncodeUriComponent = objHtmlfile.parentWindow.encode(str)
End Function
[/vba]

[vba]
Код
'заворачиваем данные из диапазона rng в JSON
Public Function ToArrJSON(rng As Range) As String
' Make sure there are two columns in the range
If rng.Columns.Count < 2 Then
ToArrJSON = CVErr(xlErrNA)
Exit Function
End If

Dim dataLoop, headerLoop As Long
' Get the first row of the range as a header range
Dim headerRange As Range: Set headerRange = Range(rng.Rows(1).Address)

Dim colCount As Long: colCount = headerRange.Columns.Count

Dim json As String: json = "["

For dataLoop = 0 To rng.Rows.Count
' Include the first header row as well
If dataLoop > 0 Then
' Start data row
Dim rowJson As String: rowJson = "["

For headerLoop = 1 To colCount
rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
rowJson = rowJson & ","
Next headerLoop

' Strip out the last comma
rowJson = Left(rowJson, Len(rowJson) - 1)

' End data row
json = json & rowJson & "],"
End If
Next

' Strip out the last comma
json = Left(json, Len(json) - 1)

json = json & "]"

ToArrJSON = json
End Function
[/vba]

Google Script часть:

[vba]
Код
function doPost(e) {

let ss = SpreadsheetApp.openById('************'); //id файла
let sheet = ss.getSheetByName('*******');//имя листа

let content = e.parameter.content;
let parsedContent = JSON.parse(content);
let ResultArray = [parsedContent[0].slice()];

for (let i=1; i<parsedContent.length; i++) {
ResultArray.push( parsedContent[i].slice() )
}

let needRows = ResultArray.length;
let needCols = ResultArray[0].length;

sheet.getRange(1, 1, needRows, needCols).setValues(ResultArray)
}
[/vba]

Сохраняем. Делаем развёртывание. У меня всё работает. Присваиваем в VBA переменной webAppId нужный адрес Вэб-Приложения (после развёртывания копируем с экрана) .

В прикреплённом скрине все подключения, которые у меня есть в Tools => References =>

Автор - airatgimranoff
Дата добавления - 13.06.2023 в 18:52
00vlad_z00 Дата: Четверг, 06.02.2025, 11:24 | Сообщение № 22
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

2024
если вдруг на вашем компьютере IE не установлен, то по состоянию на сегодня я, увы, не знаю, чем вам помочь в рассматриваемом вопросе... Разумеется, ручное выполнение GET-запроса возможно в любом браузере, хотя это и будет несколько менее элегантно, чем из автоматической процедуры

Всех приветствию!
Надеюсь есть кто-то живой в ветке
Есть ли актуальный на данный 2025 год способ фэтчить URL
Учитывая что IE нас покинул безвозвратно!
С Edge что-то не прокатывает у меня
401 ошибка Авторизации выскакивает


Учу Таблицы
Так и не выучу..


Сообщение отредактировал 00vlad_z00 - Четверг, 06.02.2025, 11:39
 
Ответить
Сообщение
если вдруг на вашем компьютере IE не установлен, то по состоянию на сегодня я, увы, не знаю, чем вам помочь в рассматриваемом вопросе... Разумеется, ручное выполнение GET-запроса возможно в любом браузере, хотя это и будет несколько менее элегантно, чем из автоматической процедуры

Всех приветствию!
Надеюсь есть кто-то живой в ветке
Есть ли актуальный на данный 2025 год способ фэтчить URL
Учитывая что IE нас покинул безвозвратно!
С Edge что-то не прокатывает у меня
401 ошибка Авторизации выскакивает

Автор - 00vlad_z00
Дата добавления - 06.02.2025 в 11:24
Seneg Дата: Среда, 27.08.2025, 20:00 | Сообщение № 23
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

ГуглДокс - это что имеется ввиду ?
Это где через браузер надо заходить ?
 
Ответить
СообщениеГуглДокс - это что имеется ввиду ?
Это где через браузер надо заходить ?

Автор - Seneg
Дата добавления - 27.08.2025 в 20:00
Platina Дата: Воскресенье, 26.10.2025, 19:32 | Сообщение № 24
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Всем привет!
Не как не получается пронумеровать отдельно выведенный список из других ячеек.
Другие ячейки на 1 Листе, а выделенный список на 2 Листе
Или может внести в формулу какие то значения =TEXTJOIN(CHAR(10); TRUE; 'Лист1'!B2:B8)

Вот ссылка может кто подскажет.My WebPage


Сообщение отредактировал Platina - Понедельник, 27.10.2025, 12:45
 
Ответить
СообщениеВсем привет!
Не как не получается пронумеровать отдельно выведенный список из других ячеек.
Другие ячейки на 1 Листе, а выделенный список на 2 Листе
Или может внести в формулу какие то значения =TEXTJOIN(CHAR(10); TRUE; 'Лист1'!B2:B8)

Вот ссылка может кто подскажет.My WebPage

Автор - Platina
Дата добавления - 26.10.2025 в 19:32
bigor Дата: Воскресенье, 26.10.2025, 21:42 | Сообщение № 25
Группа: Проверенные
Ранг: Старожил
Сообщений: 1402
Репутация: 275 ±
Замечаний: 0% ±

нет
Platina, ваш вопрос не соответствует этой теме. И ссылка нерабочая
 
Ответить
СообщениеPlatina, ваш вопрос не соответствует этой теме. И ссылка нерабочая

Автор - bigor
Дата добавления - 26.10.2025 в 21:42
Pelena Дата: Понедельник, 27.10.2025, 00:34 | Сообщение № 26
Группа: Админы
Ранг: Местный житель
Сообщений: 19569
Репутация: 4646 ±
Замечаний: ±

Excel 365 & Mac Excel
Platina, переместила Вашу первую тему в нужный раздел


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеPlatina, переместила Вашу первую тему в нужный раздел

Автор - Pelena
Дата добавления - 27.10.2025 в 00:34
Platina Дата: Вторник, 28.10.2025, 22:51 | Сообщение № 27
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Спасибо а можно узнать куда


Сообщение отредактировал Platina - Вторник, 28.10.2025, 23:00
 
Ответить
СообщениеСпасибо а можно узнать куда

Автор - Platina
Дата добавления - 28.10.2025 в 22:51
Pelena Дата: Среда, 29.10.2025, 09:06 | Сообщение № 28
Группа: Админы
Ранг: Местный житель
Сообщений: 19569
Репутация: 4646 ±
Замечаний: ±

Excel 365 & Mac Excel


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщениесюда
http://www.excelworld.ru/forum/23-55102-1

Автор - Pelena
Дата добавления - 29.10.2025 в 09:06
  • Страница 2 из 2
  • «
  • 1
  • 2
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!