• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

    Giriş yap veya Şimdi kayıt ol

Çözüldü Google E-Sheets veri aktarımı

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Y

Yakup_Sasmaz

Yeni Üye
Katılım
17 Mar 2021
Mesajlar
38
Çözümler
1
Aldığı beğeni
8
Excel V
Office 2019 TR
Merhabalar, pc deki dosyamdan butonla Google e sheets veri aktarımı yapılabiliyor mu?
 
Çözüm
Emre
Bu kod fonksiyonu ile göndermek istediğiniz metinleri URL için uygun hale getirebilirsiniz.🙂

Kod: 
Function URLEncode(ByVal Text As String) As String
  Dim i As Integer
  Dim acode As Integer
  Dim char As String
  URLEncode = Text
  For i = Len(URLEncode) To 1 Step -1
    acode = Asc(Mid$(URLEncode, i, 1))
    Select Case acode
      Case 48 To 57, 65 To 90, 97 To 122
        ' don't touch alphanumeric chars
      Case 32
        ' replace space with "+"
        Mid$(URLEncode, i, 1) = "+"
      Case Else
        ' replace punctuation chars with "%hex"
        URLEncode = Left$(URLEncode, i - 1) & "%" & Hex$(acode) & Mid$(URLEncode, i + 1)
    End Select
  Next
End Function
Tarihe göre sırala Oylara göre sırala
Merhaba, buna benzer, ama ben haftalık veri girip yani belki 100 satır veriyi göndermek istiyorum, bunda form üzerinden tek tek yapılıyor, benli userform girdileri yerine excel sayfası hücreleri gösterilerek yapılabilir. Yarın deneyeceğim.
 
Olumlu oy 0 Negatif oyla

Ekli dosyalar

Olumlu oy 0 Negatif oyla
Olumlu oy 0 Negatif oyla
Dosyayı DRIVE içine attığınız zaman. DRIVE'da sağ tıkladığınız zaman "OPEN WITH GOOGLE SHEETS" diye seçenek var.
İşinizi görür mü acaba.
 
Olumlu oy 0 Negatif oyla
muratgunay48' Alıntı:
Dosyayı DRIVE içine attığınız zaman. DRIVE'da sağ tıkladığınız zaman "OPEN WITH GOOGLE SHEETS" diye seçenek var.
İşinizi görür mü acaba.
Genişletmek için tıkla...
Yani mantık güzel. Bu sayede direk Driver e aktarmış olur.
Birde şu yol var Çalıştığı exceli Google Driver in otomatik senkronizasyonuna alır ise o dosyanın yedeğini de paylaşarak bilgisayardaki halini onlineymişcesine paylaşabilir.
 
Olumlu oy 0 Negatif oyla
Merhabalar, bir çözüm buldum gibi. Fakat kod tek satırda çok uzun oldu. Alt satırlara nasıl bölebilirim.

Kod:
HTML: 
URL_Last = "&entry.2018413592=" & No & "&entry.1196708547=" & Proje_Adı & "&entry.33112888=" & VP_No & "&entry.782531209=" & Araştırmacı & "&entry.1228546863=" & Tarih & "&entry.2135787421=" & Başlangıç_Saati & "&entry.1647487250=" & Bitiş_Saati & "&entry.825056790=" & Bulut_Oranı & "&entry.1726489239=" & Rüzgâr_Yönü & "&entry.1106384055=" & Rüzgâr_Hızı & "&entry.115164128=" & Yağış & "&entry.1030878288=" & Sıcaklık & "&entry.57626858=" & Görüş_Mes & "&entry.1382577901=" & Ref & "&entry.571212351=saat&entry.1923549909=" & No & "&entry.167635071=" & No & "&entry.1405148265=" & No & "&entry.54427426=" & No & "&entry.1006411676=" & No & "&entry.509072891=A&entry.2047341285=A&entry.996357210=A&entry.1264294245=B&entry.114919666=B&entry.474827062=B&entry.1565649556=B&entry.474690635=C&entry.428389236=C&entry.619441892=C&entry.1113318297=C&entry.1631253099=A&entry.497873361=A&entry.959863630=A&entry.1144217190=A&entry.1274529824=B&entry.2121139954=B&entry.895552952=B&entry.792059790=B&entry.2095450017=Deneme+3"
 
Olumlu oy 0 Negatif oyla
Bölmek istedigin yere bir boşluk ve alt tire koyup enter e bas
 
Olumlu oy 0 Negatif oyla
Emre' Alıntı:
Bende dosyası var ama şuan site xlsb formatını desteklemiyor.
Genişletmek için tıkla...
Emre sizin dosyayı kullanıp kendime uyarlamaya çalışıyorum. Türkçe karakter hatası alıyorum. Sizde de olmuşmuydu.

12.JPG


Rich (BB code): 
Sub SendToGoogle()

Dim URL_First As String
Dim URL_Last As String
Dim Form_URL As String
Dim HeaderName As String
Dim SendID As String

Dim EmpID As String
Dim EmpName As String
Dim Gender As String
Dim Designation As String
Dim Address As String

Set a = Sheets("google").Range("A2")
Set b = Sheets("google").Range("B2")
Set c = Sheets("google").Range("C2")
Set d = Sheets("google").Range("D2")
Set e = Sheets("google").Range("E2")
Dim TicketInfo As MSXML2.ServerXMLHTTP60
HeaderName = "Content-Type"   '
SendID = "application/x-www-form-urlencoded; charset= utf-8"
URL_First = "Data"
URL_Last = "usp=pp_url&entry.1578623695=" & a.Value & "&entry.329853574=" & b.Value & "&entry.300436266=" & c.Value & "&entry.1140690133=" & d.Value & "&entry.1268640971=" & e.Value & "&submit = Submit"
Form_URL = URL_First & URL_Last
Set TicketInfo = New ServerXMLHTTP60
TicketInfo_Open "POST", Form_URL, False
TicketInfo.setRequestHeader HeaderName, SendID
TicketInfo.send
If TicketInfo.statusText = "OK" Then
  Call Reset
  MsgBox "Veri Aktarma İşlemi Başarılı!"
Else
  MsgBox "Bir Problem Var."
End If
End Sub
Private Sub CommandButton1_Click()
Dim i As VbMsgBoxResult
i = MsgBox("Bilgiler Aktarılsın mı?", vbYesNo + vbQuestion, "Transfer")
If i = vbNo Then Exit Sub
Call SendToGoogle
End Sub
 
Olumlu oy 0 Negatif oyla
Yakup_Sasmaz' Alıntı:
Emre sizin dosyayı kullanıp kendime uyarlamaya çalışıyorum. Türkçe karakter hatası alıyorum. Sizde de olmuşmuydu.

Ekli dosyayı görüntüle 150


Sub SendToGoogle()

Dim URL_First As String
Dim URL_Last As String
Dim Form_URL As String
Dim HeaderName As String
Dim SendID As String

Dim EmpID As String
Dim EmpName As String
Dim Gender As String
Dim Designation As String
Dim Address As String

Set a = Sheets("google").Range("A2")
Set b = Sheets("google").Range("B2")
Set c = Sheets("google").Range("C2")
Set d = Sheets("google").Range("D2")
Set e = Sheets("google").Range("E2")

Dim TicketInfo As MSXML2.ServerXMLHTTP60

HeaderName = "Content-Type" '

SendID = "application/x-www-form-urlencoded; charset= utf-8"


URL_First = "Data"

URL_Last = "usp=pp_url&entry.1578623695=" & a.Value & "&entry.329853574=" & b.Value & "&entry.300436266=" & c.Value & "&entry.1140690133=" & d.Value & "&entry.1268640971=" & e.Value & "&submit = Submit"

Form_URL = URL_First & URL_Last

Set TicketInfo = New ServerXMLHTTP60

TicketInfo_Open "POST", Form_URL, False

TicketInfo.setRequestHeader HeaderName, SendID

TicketInfo.send


If TicketInfo.statusText = "OK" Then

Call Reset
MsgBox "Veri Aktarma İşlemi Başarılı!"

Else
MsgBox "Bir Problem Var."
End If

End Sub


Private Sub CommandButton1_Click()
Dim i As VbMsgBoxResult

i = MsgBox("Bilgiler Aktarılsın mı?", vbYesNo + vbQuestion, "Transfer")

If i = vbNo Then Exit Sub

Call SendToGoogle

End Sub
Genişletmek için tıkla...
 
Olumlu oy 0 Negatif oyla
Bu kod fonksiyonu ile göndermek istediğiniz metinleri URL için uygun hale getirebilirsiniz.🙂

Kod: 
Function URLEncode(ByVal Text As String) As String
  Dim i As Integer
  Dim acode As Integer
  Dim char As String
  URLEncode = Text
  For i = Len(URLEncode) To 1 Step -1
    acode = Asc(Mid$(URLEncode, i, 1))
    Select Case acode
      Case 48 To 57, 65 To 90, 97 To 122
        ' don't touch alphanumeric chars
      Case 32
        ' replace space with "+"
        Mid$(URLEncode, i, 1) = "+"
      Case Else
        ' replace punctuation chars with "%hex"
        URLEncode = Left$(URLEncode, i - 1) & "%" & Hex$(acode) & Mid$(URLEncode, i + 1)
    End Select
  Next
End Function
 
Olumlu oy 1 Negatif oyla
Çözüm
İstediğin şeyi elde ettiğin zaman soruyu çözüldü olarak değiştirebilirsiniz.
 
Olumlu oy 0 Negatif oyla
Emre' Alıntı:
Bu kod fonksiyonu ile göndermek istediğiniz metinleri URL için uygun hale getirebilirsiniz.🙂

Kod: 
Function URLEncode(ByVal Text As String) As String
  Dim i As Integer
  Dim acode As Integer
  Dim char As String
  URLEncode = Text
  For i = Len(URLEncode) To 1 Step -1
    acode = Asc(Mid$(URLEncode, i, 1))
    Select Case acode
      Case 48 To 57, 65 To 90, 97 To 122
        ' don't touch alphanumeric chars
      Case 32
        ' replace space with "+"
        Mid$(URLEncode, i, 1) = "+"
      Case Else
        ' replace punctuation chars with "%hex"
        URLEncode = Left$(URLEncode, i - 1) & "%" & Hex$(acode) & Mid$(URLEncode, i + 1)
    End Select
  Next
End Function
Genişletmek için tıkla...
Emre bey, makro ya çok hakim değilim, bunu kendi kodumun bulunduğu yerde mi yapacam yoksa Google e sheet te karakter bozukluğu olan hücrelerime mi uygulamam lazım.
 
Olumlu oy 0 Negatif oyla
Emre' Alıntı:
İstediğin şeyi elde ettiğin zaman soruyu çözüldü olarak değiştirebilirsiniz.
Genişletmek için tıkla...
Emre Bey, başka bir siteye de yazmıştım. Alttaki kod ile çözdüm.

Veri aktarırken benim gördüğü dikkat etmek gereken şeyler: Excel formunuzda "saat" ve "tarih" varsa google forma "saat" veya "tarih" diye soru oluşturmayın. Veriyi aktarmıyor. Ben "kısa metin" olarak ayarlayıp durumu çözdüm. Ayrıca Excel formunuzdaki "saat" ve "tarih" kısmını da metin olarak ayarlamanız gerekiyor. Excel ve form verilerini dikkatli yapmak gerekiyor. E tablo da neler yapılabiliyor daha bakamadım. Fakat çok başarılı bir içeriği olduğunu gördüm. Sorunlar çıktıkça sizlerle de paylaşırım. Tekrar herkese teşekkür ederim.


HTML: 
Dim TicketInfo As MSXML2.ServerXMLHTTP60
    With CreateObject("htmlfile")
        .parentWindow.execScript "function encode(s) {return encodeURIComponent(s);}", "jscript"
        a = .parentWindow.encode(Sheets("google").Range("A2").Value)
        b = .parentWindow.encode(Sheets("google").Range("B2").Value)
        c = .parentWindow.encode(Sheets("google").Range("C2").Value)
        d = .parentWindow.encode(Sheets("google").Range("D2").Value)
        e = .parentWindow.encode(Sheets("google").Range("E2").Value)
    End With
 
Olumlu oy 0 Negatif oyla
Yakup_Sasmaz' Alıntı:
Emre bey, makro ya çok hakim değilim, bunu kendi kodumun bulunduğu yerde mi yapacam yoksa Google e sheet te karakter bozukluğu olan hücrelerime mi uygulamam lazım.
Genişletmek için tıkla...
Bu ayrı bir makro. Bir modüle koyup veriyi aktarırken başka bir kod dizisi içinde çalıştırabilirsiniz.
 
Olumlu oy 0 Negatif oyla
Yakup_Sasmaz' Alıntı:
Emre Bey, başka bir siteye de yazmıştım. Alttaki kod ile çözdüm.

Veri aktarırken benim gördüğü dikkat etmek gereken şeyler: Excel formunuzda "saat" ve "tarih" varsa google forma "saat" veya "tarih" diye soru oluşturmayın. Veriyi aktarmıyor. Ben "kısa metin" olarak ayarlayıp durumu çözdüm. Ayrıca Excel formunuzdaki "saat" ve "tarih" kısmını da metin olarak ayarlamanız gerekiyor. Excel ve form verilerini dikkatli yapmak gerekiyor. E tablo da neler yapılabiliyor daha bakamadım. Fakat çok başarılı bir içeriği olduğunu gördüm. Sorunlar çıktıkça sizlerle de paylaşırım. Tekrar herkese teşekkür ederim.


Dim TicketInfo As MSXML2.ServerXMLHTTP60

With CreateObject("htmlfile")
.parentWindow.execScript "function encode(s) {return encodeURIComponent(s);}", "jscript"
a = .parentWindow.encode(Sheets("google").Range("A2").Value)
b = .parentWindow.encode(Sheets("google").Range("B2").Value)
c = .parentWindow.encode(Sheets("google").Range("C2").Value)
d = .parentWindow.encode(Sheets("google").Range("D2").Value)
e = .parentWindow.encode(Sheets("google").Range("E2").Value)
End With
Genişletmek için tıkla...
Tamamdır kolay gelsin.
 
Olumlu oy 0 Negatif oyla
Yakup_Sasmaz' Alıntı:
Merhabalar, bir çözüm buldum gibi. Fakat kod tek satırda çok uzun oldu. Alt satırlara nasıl bölebilirim.

Kod:
HTML: 
URL_Last = "&entry.2018413592=" & No & "&entry.1196708547=" & Proje_Adı & "&entry.33112888=" & VP_No & "&entry.782531209=" & Araştırmacı & "&entry.1228546863=" & Tarih & "&entry.2135787421=" & Başlangıç_Saati & "&entry.1647487250=" & Bitiş_Saati & "&entry.825056790=" & Bulut_Oranı & "&entry.1726489239=" & Rüzgâr_Yönü & "&entry.1106384055=" & Rüzgâr_Hızı & "&entry.115164128=" & Yağış & "&entry.1030878288=" & Sıcaklık & "&entry.57626858=" & Görüş_Mes & "&entry.1382577901=" & Ref & "&entry.571212351=saat&entry.1923549909=" & No & "&entry.167635071=" & No & "&entry.1405148265=" & No & "&entry.54427426=" & No & "&entry.1006411676=" & No & "&entry.509072891=A&entry.2047341285=A&entry.996357210=A&entry.1264294245=B&entry.114919666=B&entry.474827062=B&entry.1565649556=B&entry.474690635=C&entry.428389236=C&entry.619441892=C&entry.1113318297=C&entry.1631253099=A&entry.497873361=A&entry.959863630=A&entry.1144217190=A&entry.1274529824=B&entry.2121139954=B&entry.895552952=B&entry.792059790=B&entry.2095450017=Deneme+3"
Genişletmek için tıkla...
Boşluk ALT TİRE boşluk ENTER şeklinde yapınız.
 
Olumlu oy 0 Negatif oyla
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst